Для, если, ElseIf, Else Application.Match Loop дает неверные результаты - PullRequest
Новая
       8

Для, если, ElseIf, Else Application.Match Loop дает неверные результаты

1 голос
/ 26 сентября 2019

Я использую код Excel VBA, чтобы упростить сортировку и фильтрацию по нескольким рабочим книгам / листам для размещения на листе «МАТЧИ» в рабочей книге, содержащей код VBA.Эта рабочая книга "MATCHES" также содержит другую рабочую таблицу, содержащую данные "SOURCES" для нескольких местоположений рабочих листов в одной или двух рабочих таблицах для каждой рабочей книги для проверки.Я очень далеко продвинулся в своем коде, но я сталкиваюсь с проблемой, которая приводит к тому, что Application.Match не работает должным образом через For , Если, ElseIf , Else loop.Ниже приведен код, который я использую на якорном листе ("WB2") и двух других листах на данный момент. 

Sub MATCH()

' KEY: 
' L = LIVE worksheet
' T = TEST worksheet
' R = Range (LR, TR)
' B, C, F = Column of values to match (LB, TB, LC, TC, LF, TF)
' # (2,13,etc.) = number associated with SOURCES worksheet (LB2, TF13, TR13, etc.)
' MV = Match value
' MX = Maximum rows of data compared among all sheets
' AR = Active Row Number
' WB = Workbook

' Start position
ThisWorkbook.Worksheets("MATCHES").Activate
Cells(2, 1).Activate
' Calculate max rows among sheets
Dim MX1 As Range: Set MX1 = Worksheets("SOURCES").Range("D2:D17") 'LIVE worksheets
Dim MX2 As Range: Set MX2 = Worksheets("SOURCES").Range("D12:D17") 'TEST worksheets
Dim MX As Integer: MX = WorksheetFunction.Max(MX1, MX2) 'Max of 2 lines above

' Variables for 'Kept' worksheet
Dim Filename2 As Variant: Filename2 = Worksheets("SOURCES").Range("A2") & ".xlsx"
 If Len(Filename2) > 5 And Worksheets("SOURCES").Range("C2") = "YES" Then
    Dim WB2 As Workbook: Set WB2 = Workbooks(Filename2)
    Dim LB2 As Variant: LB2 = WB2.Worksheets("LIVE KEYS").Range("$B$1:$B$" & MX)
    Dim LC2 As Variant: LC2 = WB2.Worksheets("LIVE KEYS").Range("$C$1:$C$" & MX)
    Dim LF2 As Variant: LF2 = WB2.Worksheets("LIVE KEYS").Range("$F$1:$F$" & MX)
 End If

' Calculation Loop
For X = 2 To 5 'MX

  ' Active row number
  Dim AR As Integer: AR = ActiveCell.Row
  ' Match values from 'Kept' work sheet
  Dim MV(1 To 3) As Variant 'TEST KEPT FROM MERGE
  MV(1) = WB2.Worksheets("LIVE KEYS").Range("$B" & AR)
  MV(2) = WB2.Worksheets("LIVE KEYS").Range("$C" & AR)
  MV(3) = WB2.Worksheets("LIVE KEYS").Range("$F" & AR)

MsgBox "THE SURVEY SAYS..."

' Variables for non-kept sheets and match operations
    Dim Filename13 As Variant: Filename13 = Worksheets("SOURCES").Range("A13") & ".xlsx"
    If Len(Filename13) > 5 And Worksheets("SOURCES").Range("C13") = "YES" Then
    ' Range to search on workbook's worksheet
    Dim WB13 As Workbook: Set WB13 = Workbooks(Filename13)
    Dim TB13 As Variant: TB13 = WB13.Worksheets("TEST KEYS").Range("$B$1:$B$" & MX)
    Dim TC13 As Variant: TC13 = WB13.Worksheets("TEST KEYS").Range("$C$1:$C$" & MX)
    Dim TF13 As Variant: TF13 = WB13.Worksheets("TEST KEYS").Range("$F$1:$F$" & MX)
    ' Match results for current sheet
    Dim M13F3 As Integer: On Error Resume Next: M13F3 = Application.MATCH(MV(3), TF13, 0)
    Dim M13C2 As Integer: On Error Resume Next: M13C2 = Application.MATCH(MV(2), TC13, 0)
    Dim M13B1 As Integer: On Error Resume Next: M13B1 = Application.MATCH(MV(1), TB13, 0)
    End If
  ' If below is "True" paste values from matched row (columns A-F) into "MATCHES" sheet
  If Not IsError(M13F3) And Not IsError(M13C2) And Not IsError(M13B1) And M13B1 = M13C2 And M13B1 = M13F3 And M13C2 = M13F3 Then
    Dim TR13 As Variant: TR13 = WB13.Worksheets("TEST KEYS").Range("$A$" & M13B1 & ":$F$" & M13B1)
    Worksheets("MATCHES").Range("$A$" & AR & ":$F$" & AR) = TR13
    MsgBox "MATCH : 13"
    MsgBox "NEXT!"

    Dim Filename14 As Variant: Filename14 = Worksheets("SOURCES").Range("A14") & ".xlsx"
    If Len(Filename14) > 5 And Worksheets("SOURCES").Range("C14") = "YES" Then
    ' Range to search on workbook's worksheet
    Dim WB14 As Workbook: Set WB14 = Workbooks(Filename14)
    Dim TB14 As Variant: TB14 = WB14.Worksheets("TEST KEYS").Range("$B$1:$B$" & MX)
    Dim TC14 As Variant: TC14 = WB14.Worksheets("TEST KEYS").Range("$C$1:$C$" & MX)
    Dim TF14 As Variant: TF14 = WB14.Worksheets("TEST KEYS").Range("$F$1:$F$" & MX)
    ' Match results for current sheet
    Dim M14F3 As Integer: On Error Resume Next: M14F3 = Application.MATCH(MV(3), TF14, 0)
    Dim M14C2 As Integer: On Error Resume Next: M14C2 = Application.MATCH(MV(2), TC14, 0)
    Dim M14B1 As Integer: On Error Resume Next: M14B1 = Application.MATCH(MV(1), TB14, 0)
    End If
  ' If below is "True" paste values from matched row (columns A-F) into "MATCHES" sheet
  ElseIf Not IsError(M14F3) And Not IsError(M14C2) And Not IsError(M14B1) And M14B1 = M14C2 And M14B1 = M14F3 And M14C2 = M14F3 Then
    Dim TR14 As Variant: TR14 = WB14.Worksheets("TEST KEYS").Range("$A$" & M14B1 & ":$F$" & M14B1)
    MsgBox "THE SURVEY SAYS..."
    Worksheets("MATCHES").Range("$A$" & AR & ":$F$" & AR) = TR14
    MsgBox "MATCH : 14"
    MsgBox "NEXT!"

  Else
    ' Match results for current sheet
    Dim M2F3 As Integer: On Error Resume Next: M2F3 = Application.MATCH(MV(3), LF2, 0)
    Dim M2C2 As Integer: On Error Resume Next: M2C2 = Application.MATCH(MV(2), LC2, 0)
    Dim M2B1 As Integer: On Error Resume Next: M2B1 = Application.MATCH(MV(1), LB2, 0)
    ' If "True" paste values from matched row (columns A-F) into "MATCHES" sheet
    If Not IsError(M2F3) And Not IsError(M2C2) And Not IsError(M2B1) And M2B1 = M2C2 And M2B1 = M2F3 And M2C2 = M2F3 Then
      Dim LR2 As Variant: LR2 = WB2.Worksheets("LIVE KEYS").Range("$A$" & M2B1 & ":$F$" & M2B1)
      Worksheets("MATCHES").Range("$A$" & AR & ":$F$" & AR) = LR2
      MsgBox "MATCH : KEPT"
    End If
    MsgBox "NEXT!"

  End If

Y = X + 1
Cells(Y, 1).Activate

Next
MsgBox "GAME OVER"

End Sub

Первый цикл работает, но второй цикл сопоставляет значения из листа, где значения делаютне существует.Во втором цикле первые две рабочие книги должны быть пропущены (как False ) в цикле, а Else должны быть результатами.- Кстати, рабочая книга Else (упоминаемая выше как «закрепленный лист») - это лист («WB2»), содержащий набор объединенных данных, которые мне необходимо объединить в базе данных SQL.Другими словами, если при поиске значения из на этом листе False на других листах, то значение принадлежит записи "anchor" ("WB2"). Однако , первый лист производит True , где я вручную провел Find в Excel, чтобы проверить, что это НЕ верно, особенно эта строка ... 

Dim M13F3 As Integer: On Error Resume Next: M13F3 = Application.MATCH(MV(3), TF13, 0)

У меня есть скриншот, который может или не может помочь.

VBA Code

Кстати, я добавил еще одно изображение нижевнешний интерфейс Excel, чтобы помочь с общей картиной в случае, если есть несколько лучших способов удовлетворить мои требования.

Excel Side

Я надеюсь, что предоставил достаточно информациии не слишком много для устранения этой проблемы.Заранее спасибо!

1 Ответ

0 голосов
/ 26 сентября 2019

После сквозного чтения кода я заметил, что вы объявили: ThisWorkbook.Worksheets и, вероятно, должны прочитать Workbook.Sheet, тогда как WB2.Worksheets, вероятно, должны прочитать WB2.Sheet Все объявленные переменные также должны соответствовать синтаксическому написанию Excel, если толькоВы специально назвали Excel «Лист», «Рабочие листы» и «Рабочие книги», чтобы проверить код на наличие ошибок правописания в имени Excel.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...