如何添加第三个条件

Question

下面的代码目前正在工作。我想给它添加一些额外的细节，但我似乎做不到。现在，当它寻找"起源"时;它只查找2个变量。我想订3个。我想补充一句:

如果origin = "Name"然后CopyRows "B"， KeyToFind，(我不知道这应该是真还是假)

然后在私有子函数中现在它只能区分两个变量这里也应该添加第三个变量但我不知道怎么做因为在origin函数中它只能区分&;true &;或"False".

让我感到混乱的是，私有子元素中的偏移量随着第三个条件的变化而变化。

是否有办法在此代码中添加第三个标准?

Private aCell As Range
Dim wsImport As Worksheet
Dim wsInput As Worksheet
Dim wsOutput As Worksheet
Dim wsSpec As Worksheet
Sub Export()

Set wsImport = ThisWorkbook.Sheets("Import")
Set wsInput = ThisWorkbook.Sheets("Input")
Set wsSpec = ThisWorkbook.Sheets("Specifications")
Set wsOutput = ThisWorkbook.Sheets("Output")

Dim CriteriaA As String, CriteriaB As String, CriteriaC As String
Dim origin As String, KeytoFind As String, strAdress As String
Dim rngDB As Range
Dim LastRowImport As Long, LastRowOutput As Long
Dim i As Integer

CriteriaA = wsInput.Range("F4").Value2
CriteriaB = wsInput.Range("F5").Value2
CriteriaC = wsInput.Range("F6").Value2

Set rngDB = wsSpec.Range("h1", wsSpec.Range("h" & Rows.Count).End(xlUp))
Set aCell = rngDB.Find(What:=CriteriaA, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)


If Not aCell Is Nothing Then
strAdress = aCell.Address
Do
If aCell.Offset(, 1).Value2 = CriteriaB And _
aCell.Offset(, 2).Value2 = CriteriaC Then
  
origin = aCell.Offset(, 8).Value2
KeytoFind = aCell.Offset(, 9).Value2

If origin = "Variabele" Then
CopyRows "C", KeytoFind, True
ElseIf origin = "Rekening" Then
CopyRows "D", KeytoFind, False
End If
End If
Set aCell = rngDB.FindNext(aCell)
Loop While aCell.Address <> strAdress
End If
End Sub
Private Sub CopyRows(Col As String, Searchstring As String, PartialString As Boolean)
Dim copyFromD As Range, copyFromD1 As Range, copyFromD2 As Range, copyFromD3 As Range, copyFromD4 As Range
Dim copyFromC As Range, copyFromC1 As Range, copyFromC2 As Range, copyFromC3 As Range, copyFromC4 As Range
Dim copyFromS As Range
Dim lRow As Long, LastRow As Long

LastRow = wsOutput.Cells(Rows.Count, 9).End(xlUp).Row

With wsImport
.AutoFilterMode = False
lRow = .Range(Col & .Rows.Count).End(xlUp).Row
With .Range(Col & "1:" & Col & lRow)
If PartialString = False Then
'Rekening
.AutoFilter Field:=1, Criteria1:=Searchstring
'Key
Set copyFromD = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells
'Datum
Set copyFromD1 = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells.Offset(0, -3)
'Omschrijving
Set copyFromD2 = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells.Offset(0, -2)
'Bedrag
Set copyFromD3 = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells.Offset(0, 1)
'Variabele
Set copyFromD4 = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells.Offset(0, -1)
Else
'Variabele
.AutoFilter Field:=1, Criteria1:="=*" & Searchstring & "*"
'Key
Set copyFromC = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells
'Datum
Set copyFromC1 = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells.Offset(0, -2)
'Omschrijving
Set copyFromC2 = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells.Offset(0, -1)
'Bedrag
Set copyFromC3 = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells.Offset(0, 2)
'Variabele
Set copyFromC4 = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells.Offset(0, 0)
End If
End With
.AutoFilterMode = False
End With    
End Sub

Answer 1

最后它实际上比我想象的要容易得多。我只需要在代码中添加一些额外的if语句。下面的代码是我想要添加的更改的工作版本。也许它对其他人有用。

Option Explicit
Private aCell As Range
Dim wsImport As Worksheet
Dim wsInput As Worksheet
Dim wsOutput As Worksheet
Dim wsSpec As Worksheet
Sub Export()

Set wsImport = ThisWorkbook.Sheets("Import")
Set wsInput = ThisWorkbook.Sheets("Input")
Set wsSpec = ThisWorkbook.Sheets("Specifications")
Set wsOutput = ThisWorkbook.Sheets("Output")

Dim CriteriaA As String, CriteriaB As String, CriteriaC As String
Dim origin As String, KeytoFind As String, strAdress As String
Dim rngDB As Range
Dim LastRowImport As Long, LastRowOutput As Long
Dim i As Integer

CriteriaA = wsInput.Range("F4").Value2
CriteriaB = wsInput.Range("F5").Value2
CriteriaC = wsInput.Range("F6").Value2

Set rngDB = wsSpec.Range("h1", wsSpec.Range("h" & Rows.Count).End(xlUp))
Set aCell = rngDB.Find(What:=CriteriaA, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

If Not aCell Is Nothing Then
strAdress = aCell.Address
Do
If aCell.Offset(, 1).Value2 = CriteriaB And _
aCell.Offset(, 2).Value2 = CriteriaC Then
  
origin = aCell.Offset(, 8).Value2
KeytoFind = aCell.Offset(, 9).Value2

If origin = "Variabele" Then
CopyRows "C", KeytoFind, True
ElseIf origin = "Rekening" Then
CopyRows "D", KeytoFind, False
ElseIf origin = "Name" Then
CopyRows "B", KeytoFind, True
End If
End If
Set aCell = rngDB.FindNext(aCell)
Loop While aCell.Address <> strAdress
End If
End Sub
Private Sub CopyRows(Col As String, Searchstring As String, PartialString As Boolean)
Dim copyFromD As Range, copyFromD1 As Range, copyFromD2 As Range, copyFromD3 As Range, copyFromD4 As Range
Dim copyFromC As Range, copyFromC1 As Range, copyFromC2 As Range, copyFromC3 As Range, copyFromC4 As Range
Dim copyFromB As Range, copyFromB1 As Range, copyFromB2 As Range, copyFromB3 As Range, copyFromB4 As Range
Dim lRow As Long, LastRow As Long
Dim origin As String

LastRow = wsOutput.Cells(Rows.Count, 9).End(xlUp).Row
origin = aCell.Offset(, 8).Value2

With wsImport
.AutoFilterMode = False
lRow = .Range(Col & .Rows.Count).End(xlUp).Row
With .Range(Col & "1:" & Col & lRow)
If PartialString = False Then
'Rekening
.AutoFilter Field:=1, Criteria1:=Searchstring
'Key
Set copyFromD = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells
'Datum
Set copyFromD1 = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells.Offset(0, -3)
'Omschrijving
Set copyFromD2 = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells.Offset(0, -2)
'Bedrag
Set copyFromD3 = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells.Offset(0, 1)
'Variabele
Set copyFromD4 = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells.Offset(0, -1)
Else
If origin = "Variabele" Then
'Variabele
.AutoFilter Field:=1, Criteria1:="=*" & Searchstring & "*"
'Key
Set copyFromC = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells
'Datum
Set copyFromC1 = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells.Offset(0, -2)
'Omschrijving
Set copyFromC2 = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells.Offset(0, -1)
'Bedrag
Set copyFromC3 = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells.Offset(0, 2)
'Variabele
Set copyFromC4 = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells.Offset(0, 0)
ElseIf origin = "Name" Then
'Rekening
.AutoFilter Field:=1, Criteria1:="=*" & Searchstring & "*"
'Key
Set copyFromB = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells
'Datum
Set copyFromB1 = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells.Offset(0, -1)
'Omschrijving
Set copyFromB2 = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells.Offset(0, 0)
'Bedrag
Set copyFromB3 = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells.Offset(0, 3)
'Variabele
Set copyFromB4 = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells.Offset(0, 0)
End If
End If
End With
.AutoFilterMode = False
End With

End Sub