如何更改每個循環的輸出位置並運行多個循環

Question

我在此處有代碼循環遍歷文件列表;打開它們，提取數據並將其移入主工作簿。我想要做的事情得到它，所以abel的數據是在列C和D，然後把VARO在F和G等等我看到的問題是，放置代碼是在循環內，所以對於每個我它只會寫在上一行，而不是在不同的列在一起！

Sub Source_Data() 

Dim r 
Dim findValues() As String 
Dim Wrbk As Workbook 
Dim This As Workbook 
Dim sht As Worksheet 
Dim i 
Dim tmp 
Dim counter 
Dim c As Range 
Dim firstAddress 
Dim rng As Range 

ReDim findValues(1 To 3) 
findValues(1) = "abel" 
findValues(2) = "varo" 
findValues(3) = "Tiger" 

counter = 0 

r = Range("A1").End(xlDown).Row 
Set rng = Range(Cells(1, 1), Cells(r, 1)) 
Set This = ThisWorkbook 

For Each tmp In rng 
    Workbooks.Open tmp 
    Set Wrbk = ActiveWorkbook 
    Set sht = ActiveSheet 
     For i = 1 To 3 
      With sht.Range(Cells(1, 1), Range("A1").SpecialCells(xlCellTypeLastCell)) 
      Set c = .Find(findValues(i), LookIn:=xlValues) 
       If Not c Is Nothing Then 
        firstAddress = c.Offset(0, 2).Value 
        Do 
         This.Activate 
         tmp.Offset(0, 2).Value = tmp.Value 
         tmp.Offset(0, 3).Value = firstAddress 
         Set c = .FindNext(c) 
         counter = counter + 1 
        Loop While Not c Is Nothing And c.Value = firstAddress 
       End If 
      End With 
     Wrbk.Activate 
     Next 
    Wrbk.Close 
Next tmp 
End Sub 

**編輯：**我知道它可以通過增加一個乘數「我」的偏移值來完成，但是這使事情變得大於他們需要的是，如果我想搜索50個關鍵字

Answer 1

這裏是我的回答，跳e幫助你，並且一如既往，如果你需要改進，請告訴我。

Sub Source_Data() 
Dim r 
Dim findValues() As String 
Dim Wrbk As Workbook 
Dim This As Workbook 
Dim sht As Worksheet 
Dim i 
Dim tmp 
Dim counter 
Dim c As Range 
Dim firstAddress 
Dim rng As Range 
Dim ColNum 'the columns number var 

ReDim findValues(1 To 3) 
findValues(1) = "abel" 
findValues(2) = "varo" 
findValues(3) = "Tiger" 

counter = 0 

r = Range("A1").End(xlDown).Row 
Set rng = Range(Cells(1, 1), Cells(r, 1)) 
Set This = ThisWorkbook 

For Each tmp In rng 
    Workbooks.Open tmp 
    Set Wrbk = ActiveWorkbook 
    Set sht = ActiveSheet 
     For i = 1 To 3 
      With sht.Range(Cells(1, 1), Range("A1").SpecialCells(xlCellTypeLastCell)) 
      Set c = .Find(findValues(i), LookIn:=xlValues) 
       If Not c Is Nothing Then 
        firstAddress = c.Offset(0, 2).Value 
        Do 
         This.Activate 
         Select Case i 'Test var i (the value) 
          Case "abel" 'in case the value (that is a string) is equal to... 
           ColNum = 1 'set the var, with the number of the column you want 
          Case "varo" 'in case the value... 
           ColNum = 2 'Set the column... 
          Case "Tiger" 
           ColNum = 3 
          Case Else 'In case that the i var not match with anyvalue take this column number 
           ColNum = 20 'the garbage! 
         End Select 

         tmp.Offset(0, ColNum).Value = tmp.Value 'Put the value in the selected columns 
         tmp.Offset(0, ColNum + 1).Value = firstAddress 'and put the value to the next column of the 
                     'selected column 
         Set c = .FindNext(c) 
         counter = counter + 1 
        Loop While Not c Is Nothing And c.Value = firstAddress 
       End If 
      End With 
     Wrbk.Activate 
     Next 
    Wrbk.Close 
Next tmp 
End Sub 

注： 您需要設置ColNum VAR爲需要的值，在那裏，你真的需要存儲的i值和下一行的列數就是把地址i var

Answer 2

你可以改變這兩條線：

tmp.Offset(0, 2).Value = tmp.Value 
tmp.Offset(0, 3).Value = firstAddress 

對此

tmp.Offset(0, 2 + (i-1)*2).Value = tmp.Value 
tmp.Offset(0, 3 + (i-1)*2).Value = firstAddress