我有一个很长的宏，基本上是尝试执行以下操作：
到目前为止，这是我的代码（我尚未清理）：
Public Declare PtrSafe Function SetCurrentDirectoryA Lib "kernel32" (ByVal lpPathName As String) As Long
Sub Import_Macro()
Dim wbData As Workbook
Dim wsData As Worksheet
Dim rngData As Range
Set rngData = Selection
Set wbData = Workbooks(rngData.Parent.Parent.Name)
Set wsData = wbData.Sheets("Fehleranalyse Daten")
'DATA IMPORT
Dim wbImport As Workbook
Dim wsImport As Worksheet
Dim Lastrow_wsData As String
Dim Lastrow_wsData_neu As String
Lastrow_wsData = wsData.Range("A:A").Columns(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'Import from file
MyPath = Application.ActiveWorkbook.Path
SetCurrentDirectoryA MyPath
strFileToOpen = Application.GetOpenFilename _
(Title:="Bitte Datei für Fehler-Reporting auswählen", _
FileFilter:="Excel Files *.xls*; *.csv (*.xls*; *.csv),")
'Defining names for Import
Dim rngImport As Range
Set rngImport = Selection
Set wbImport = Workbooks(rngImport.Parent.Parent.Name)
Set wsImport = wbImport.Sheets("Sheet1")
Dim Lastrow_Import As Long
Lastrow_Import = wsImport.Range("A:A").Columns(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim AnmelderImport As Long
Dim AnmelderData As Long
Dim AbteilungImport As Long
Dim AbteilungData As Long
Dim VNrImport As Long
Dim VNrData As Long
Dim AuftragsNrImport As Long
Dim AuftragsNrData As Long
Dim VersuchImport As Long
Dim VersuchData As Long
Dim iCol As Long
Dim colnameData As Variant
Dim colnumImport As Variant
Dim lrData As Long
Dim lcData As Long
Dim lcImport As Long
Dim lrs As Long
Dim r As Long
Dim c As Long
Dim iSOP As Long
Dim j As Long
Dim i As Range
Dim k As Range
Dim n As Long
Dim Check As Variant
Dim arr As Variant
'Creating several array I need to either check for matching or copying
VersuchImport = Application.WorksheetFunction.Match("VERSUCH", wsImport.Range("11:11"), 0) 'Ermittlung der Spalte für Versuch
VersuchData = Application.WorksheetFunction.Match("VERSUCH", wsData.Range("1:1"), 0)
AuftragsNrImport = Application.WorksheetFunction.Match("AUFTRAGSNUMMER", wsImport.Range("11:11"), 0) 'Ermittlung der Spalte für Auftragsnr.
AuftragsNrData = Application.WorksheetFunction.Match("AUFTRAGSNUMMER", wsData.Range("1:1"), 0)
TestzweckImport = Application.WorksheetFunction.Match("TESTZWECK", wsImport.Range("11:11"), 0) 'Ermittlung der Spalte für Testzweck
TestzweckData = Application.WorksheetFunction.Match("TESTZWECK", wsData.Range("1:1"), 0)
StatusImport = Application.WorksheetFunction.Match("AUFTRAGSSTATUS", wsImport.Range("11:11"), 0) 'Ermittlung der Spalte für Status
StatusData = Application.WorksheetFunction.Match("AUFTRAGSSTATUS", wsData.Range("1:1"), 0)
Debug.Print "VersuchImport = " & VersuchImport
Debug.Print "VersuchData = " & VersuchData
Debug.Print "AuftragsNrImport = " & AuftragsNrImport
Debug.Print "AuftragsNrData = " & AuftragsNrData
Debug.Print "TestzweckImport = " & TestzweckImport
Debug.Print "TestzweckData = " & TestzweckData
With wsImport
Check = .Range(.Cells(1, VersuchImport).Address, .Cells(Lastrow_Import, VersuchImport).End(xlUp).Address).Value2 & .Range(.Cells(1, AuftragsNrImport).Address, .Cells(Lastrow_Import, Auftragsnr).End(xlUp).Address).Value2
End With
'I'm creating another array with column names to be copied (bayed on target file)
With wsData
lrData = wsData.Range("A:A").Columns(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lcData = Application.WorksheetFunction.Match("AUFTRAGSSTATUS", .Range("1:1"), 0)
colnameData = Application.Transpose(.Range(.Cells(1, 1), .Cells(1, lcData)).Value)
End With
'The corresponding array in the source file
With wsImport
lcImport = Application.WorksheetFunction.Match("SORTIERUNG", .Range("11:11"), 0)
ReDim colnumImport(lcImport, 1)
For iCol = 1 To lcImport
On Error Resume Next
colnumImport(iCol, 1) = .Rows(11).Find(What:=colnameData(iCol, 1), LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
Next iCol
End With
'This section copies all relevant columns and rows if not matched (not cleaned up though)
Dim lcellData As Range
Dim cellAuftragsNrImport As Range
Dim RngAuftragsNrImport As Variant
Dim RngAuftragsNrData As Variant
Dim Status As Long
Dim cellVersuchImport As Range
Dim RngVersuchImport As Variant
Dim RngVersuchData As Variant
Dim cellStatusImport As Range
Dim RngStatusImport As Variant
Dim RngStatusData As Variant
Dim cellTestzweckImport As Range
Dim RngTestzweckImport As Variant
Dim RngTestzweckData As Variant
Dim iZweck As Long
With wsImport
RngAuftragsNrImport = .Range(.Cells(12, AuftragsNrImport).Address, .Cells(Lastrow_Import, AuftragsNrImport).Address).Value2
RngTestzweckImport = .Range(.Cells(12, TestzweckImport).Address, .Cells(Lastrow_Import, TestzweckImport).Address).Value2
RngVersuchImport = .Range(.Cells(12, VersuchImport).Address, .Cells(Lastrow_Import, VersuchImport).Address).Value2
RngStatusImport = .Range(.Cells(12, StatusImport).Address, .Cells(Lastrow_Import, StatusImport).Address).Value2
End With
With wsData
RngAuftragsNrData = .Range(.Cells(3, AuftragsNrData).Address, .Cells(Lastrow_wsData, AuftragsNrData).Address).Value2
RngVersuchData = .Range(.Cells(3, VersuchData).Address, .Cells(Lastrow_wsData, VersuchData).Address).Value2
RngStatusNrData = .Range(.Cells(3, StatusData).Address, .Cells(Lastrow_wsData, StatusData).Address).Value2
RngTestzweckNrData = .Range(.Cells(3, TestzweckData).Address, .Cells(Lastrow_wsData, TestzweckData).Address).Value2
End With
ReDim arr(0)
For iZweck = LBound(RngTestzweckImport, 1) To UBound(RngTestzweckImport, 1)
If RngTestzweckImport(iZweck, 1) = "Entwicklungstest" Then
ReDim Preserve arr(j)
arr(j) = iZweck + 11
j = j + 1
End If
Next iZweck
For Each cellAuftragsNrImport In RngAuftragsNrImport
With wsData.Cells 'RngAuftragsNrData.Cells
Set i = .Find(cellAuftragsNrImport, LookIn:=xlValues, lookat:=xlWhole)
If Not i Is Nothing Then
k = i.Row
Status = .Cells(k, StatusData).Value
If cellStatusImport.Value <> Status Then
cellStatusImport.Copy Destination:=wsData.Cells(i.Row, StatusData)
End If
Else
With wsData
lrData = Lastrow_wsData
For r = LBound(arr) To UBound(arr)
lrData = .Cells(.Rows.Count, 1).End(xlUp).Row
For c = 1 To lcData
.Cells(lrData + 1, c).Value = wsImport.Cells(arr(r), colnumImport(c, 1)).Value
Next c
Next r
End With
End If
End With
Next
End Sub
所有以“导入”结尾的名称均来自源文件。所有以“ Data”结尾的名称均用于目标文件。
我想要达到的目标：
宏应检查源文件的项目是否已在目标文件中。这仅适用于包含值“ Entwicklungstest”的行（请参阅arr）。
要检查的标准是：AuftragsNr（订单ID），Testzweck和日期。到目前为止，我的宏仅检查AuftragsNr。即使对于单个条件，我的宏也无法正常工作。因此，基本上，如果目标文件中不满足上述3个条件，则应添加新行。如果符合条件，则必须使用源文件中的值更新“状态”列。
执行宏时，它所做的就是在目标文件的最后一行之后添加所有带有“ Entwicklungstest”的行。
有人知道如何解决这个问题吗？我需要更改什么！
提前非常感谢您的努力！