2017-04-03 64 views
0

背景信息:我的工具的目的是我在那裏當你在一個單元格中輸入一個名稱的表格,並帶來了所有的連接到細節那些人使用vlookups和基本的excel代碼來命名。雙每個迴路(如何解決此問題?)Excel的VBA

現在我在做什麼是我想點擊一個按鈕,讓VBA通過該工具運行所有的名稱,以便從形式上的細節都存儲在表中。下面的代碼返回For Each Loop中第一個框的第一列數據(如果第二個for循環被移除,這樣做會很好)。我有的問題是我需要每個循環的第二個返回第二列值的數據,但問題是這是每個循環的第一個只運行一次,然後它會運行第二次爲每個循環多次返回第二個我需要的數據列。我需要的是每個循環可以有2個範圍或完全不同的方式來做到這一點。任何幫助將非常感激。

Public Sub Button1_Click() 

Application.ScreenUpdating = True 

Dim copySheet As Worksheet 
Dim pasteSheet As Worksheet 
Dim r As Range 
Dim h As Range 

Set copySheet = Worksheets("WIN RATES") 

With copySheet 
    For Each r In .Range("H3", .Range("H" & Rows.Count).End(xlUp)) 
     If Len(r) > 0 Then 
      Worksheets("NEW! FORM CHARTS").Range("E4").Value = r.Value 
      Worksheets("NEW! FORM CHARTS").Range("E4").Resize(, 1).Copy 
      Worksheets("Full Over 2.5 & BTTS list").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 
      Application.CutCopyMode = False 

     With copySheet 
      For Each h In .Range("N3", .Range("N" & Rows.Count).End(xlUp)) 
      If Len(h) > 0 Then 
      Worksheets("NEW! FORM CHARTS").Range("M4").Value = h.Value 
      Worksheets("NEW! FORM CHARTS").Range("M4").Resize(, 1).Copy 
      Worksheets("Full Over 2.5 & BTTS list").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 
      Application.CutCopyMode = False 
        End If 
       Next h 
      End With 
     End If 
    Next r 
End With 

Application.CutCopyMode = False 
Application.ScreenUpdating = True 

End Sub 

我希望它返回的方法是這樣的:

Name 1 | Name 2 
tom | 17846 
mike | 16253 
steve | 10987 
Anne | 16243 

但是,善解人意,我的數據是這樣做的:

Name 1 | Name 2 
tom | 17846 
     | 16253 
     | 10987 
     | 16243 

的想法是,Excel將通過所有運行列表中的名稱並填寫名稱1和名稱2的表格,連同這些名稱輸入到表單中,他們將填寫表格的其餘部分,並在excel表格中使用vlookups,因此我的最終目標是擁有這個樣的表,其中vlookup1和vlookup2是從excel表:

Name 1 | Name 2 | VLOOKUPDATA1 | VLOOKUPDATA2 
tom | 17846 |  1  |  80% 
mike | 16253 |  8  |  90% 
steve | 10987 |  6  |  23% 
Anne | 16243 |  3  |  43%  

我知道這是長篇大論,只是問我,如果你需要任何澄清。

+1

只要提到,請確保在使用'Rows.Count'時完全限定範圍。如果沒有放置工作表,即「工作表(」Full Over 2.5&BTTS list「).Rows.Count',它將從任何活動工作表拉取行數,這可能不是您想要的。因此,在'With copySheet'循環中,確保在Rows.Count之前添加「anchor」。「以確保它正在計算'copySheet'上的'Rows'。 – BruceWayne

+1

我不認爲你需要2'與'塊 –

+0

請修復您的縮進。如果你不確定該怎麼做,請使用[Rubberduck](http://rubberduckvba.com/indentation)的壓頭(免責聲明:我管理這個開源項目)。 –

回答

0

你不需要兩個循環,只是一個在每次迭代中獲取從列「H」和「N」的數據。有了這麼多的數據,每次複製和粘貼一個單元需要非常長的時間 - 讀取和寫入數組會更好。下面

代碼顯示了這兩點。我真的不明白爲什麼要將每個項目寫入「NEW!FORM CHARTS」工作表,只是爲了在下一個循環中寫下它,所以我已經將該部分留在了代碼中。你會看到有一點額外的編碼,只處理兩列不在同一行結束的情況。

我也建議你閱讀類,因爲這將極大地簡化並可能加快你的任務。

Dim home As Variant 
Dim away As Variant 
Dim r As Long, rMax As Long, rOffset As Long 
Dim output() As Variant 

With ThisWorkbook.Worksheets("WIN RATES") 
    home = .Range(.Range("H3").End(xlDown), .Range("H" & .Rows.Count).End(xlUp)).Value2 
    away = .Range(.Range("N3").End(xlDown), .Range("N" & .Rows.Count).End(xlUp)).Value2 
End With 

rMax = WorksheetFunction.Max(UBound(home, 1), UBound(away, 1)) 

ReDim output(1 To rMax, 1 To 2) 
For r = 1 To rMax 
    If r <= UBound(home, 1) Then output(r, 1) = home(r, 1) 
    If r <= UBound(away, 1) Then output(r, 2) = away(r, 1) 
Next 

With ThisWorkbook.Worksheets("Full Over 2.5 & BTTS list") 
    rOffset = WorksheetFunction.Max(.Range("A1").End(xlUp).Row, .Range("A2").End(xlUp).Row) 
    .Range("A1").Offset(rOffset).Resize(UBound(output, 1), UBound(output, 2)).Value = output 
End With