VBA从数据转储连接多个范围

如何解决VBA从数据转储连接多个范围

我的目标是根据工作表中添加的文件，将两个单元格区域相互连接并有条件地再添加一个字符串。

第一个范围开始于单元格C2，结束于AF列的最后一行。 要连接的单元格始终位于同一行上，并在右侧31个单元格中。

如果原始单元格的前两个数字> = 22或

使情况复杂化的是，将上述For循环添加到For循环的背面，以查找要作为数据转储添加到工作簿中的文件。不知何故，连接过程的For循环被完全跳过了，我不知道为什么。

Sub Get_Files()
'turn off automatic calculations
Application.Calculation = xlManual

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim worksheetName As String
Dim i As Integer,j As Integer,k As Integer,l As Integer
Dim LastRw As Long
Dim x As Workbook,y As Workbook
Dim ws1 As Worksheet,ws2 As Worksheet
Dim newString As String



'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(Cells(1,2).Value)
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.files
'print file name
Cells(i + 10,1) = objFile.Name
'print file last updated
Cells(i + 10,2) = objFile.DateLastModified


'print file path without xls
If objFile.Name Like "*.xls" Then

    worksheetName = Replace(objFile.Name,".xls","")
   
    Set x = Workbooks.Open(objFile.path)
    Set y = ThisWorkbook
    
    'Check if worksheet exists
    
        For j = 1 To y.Worksheets.Count
        If y.Worksheets(j).Name = worksheetName Then
            exists = True
        End If
        Next j
        
        If Not exists Then
            y.Worksheets.Add.Name = worksheetName
        End If
        
        
 
    Set ws1 = x.Sheets(worksheetName)
    Set ws2 = y.Sheets(worksheetName)
    
    
    ws1.Cells.Copy ws2.Cells
    x.Close True
    
    LastRw = ws2.Range("C2").Cells.End(xlDown).Row
    
            For k = 3 To k = LastRw
                For l = 2 To l = 33
                    
                    If Len(ws2.Cells(k + 31,l)) <> 0 Then
                        
                        If Trim(ws2.Cells(k,1 + 31)) = "DA" _
                        Or Trim(ws2.Cells(k,1 + 31)) = "DR" _
                        Or Trim(ws2.Cells(k,1 + 31)) = "LA" _
                        Or Trim(ws2.Cells(k,1 + 31)) = "LR" _
                        Or Trim(ws2.Cells(k,1 + 31)) = "EG" Then
                           
                           If CInt(Trim(Left(ws2.Cells(k,l),2))) >= 22 _
                           Or CInt(Trim(Left(ws2.Cells(k,2))) <= 4 Then
                           newString = Trim(ws2.Cells(k,1 + 31)) & Trim(ws2.Cells(k,l)) & " ND"
                           
                           Else
                               If CInt(Trim(Left(ws2.Cells(k,2))) <= 5 Then
                               newString = Trim(ws2.Cells(k,l)) & " SV"
                               Else
                                   newString = Trim(ws2.Cells(k,l))
                               End If
                           End If
                            
                        End If
                    Else
                    
                    newString = Trim(ws2.Cells(k,l))
                    
                    End If
                    
                    ws2.Cells(k,l).Value = newString
                    
                    l = l + 1
                    
                Next l
                
                k = k + 1
                
            Next k
    
    ws2.Visible = xlSheetHidden
    
    exists = False
   
End If

i = i + 1
Next objFile


MsgBox "Update complete. Check last update timestamps of files."

ThisWorkbook.Sheets("Access Control").Activate

'turn on automatic calculations
Application.Calculation = xlAutomatic

End Sub

解决方法

For k = 3 To k = LastRw
   For l = 2 To l = 33

这两行语法不正确。当您编写For k = 3 to k = LastRw时，其结果为For k = 3 to False或For k = 3 to 0，因此循环将永远不会运行。这需要是：

For k = 3 To LastRw
   For l = 2 To 33