Question

我这里有代码，循环遍历文件列表;打开它们，提取数据并将其移动到主工作簿中。我想要做的是让abel的数据在c和d列中然后将varo放在f和g等中我看到的问题是放置代码在循环内部因此对于每个i它只会写在前一行而不是一起在不同的列中！

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

**编辑：**我知道可以通过添加＆＃34; i＆＃34;的乘数来完成。到偏移值，但如果我想搜索50个关键字，这会使事情变得比他们需要的更大

Answer 1

以下是我的回答，希望能帮助您，并且一如既往，如果您需要改进，请告诉我。

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值的列数放在那里，下一行是放置{的地址{1}} 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

如何更改每个循环的输出位置并运行多个循环

2 个答案: