Есть ли способ использовать VBA для сравнения двух таблиц на отдельных листах и ​​определения соответствия или соответствия критериям? - PullRequest
Новая
       11

Есть ли способ использовать VBA для сравнения двух таблиц на отдельных листах и ​​определения соответствия или соответствия критериям?

0 голосов
/ 29 января 2020

Я пытался создать код, который позволил бы мне сравнить одну таблицу (в данном случае, список инвентаря) с другой таблицей (спецификация клиентской части). Я думал о создании al oop, который будет искать таблицу инвентаризации по номеру тега (столбец A), ссылаться на несколько его атрибутов (класс, калибр, ширина и т. Д. c '), а затем искать в таблице номеров деталей те атрибуты (точный класс, диапазон датчика, диапазон ширины и т. д. c). Если будет найдено совпадение, я бы хотел, чтобы он показал мне соответствующий номер детали или, по крайней мере, наличие совпадения.

Я не знаком с зацикливанием или смещением ссылочных тегов, поэтому я не уверен, как лучше всего подойти к этому. Любая помощь будет оценена! Я очень новичок в VBA, и я учусь, как я go.

Вот код, который я создал ручной поиск. Это требует, чтобы вы выбрали тег, который вы хотите найти, и ссылается на атрибуты над таблицей номеров деталей: 

Sub FilterInventoryToPartSearch()

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

'   Filter Active Inventory

    Dim lo5 As ListObject
    Set lo5 = Sheet5.ListObjects(1)
    lo5.AutoFilter.ShowAllData
    With lo5.Range
'   Filter by Material Type

    If Sheet5.Range("f2").Text <> "" Then
        .AutoFilter field:=5, Criteria1:=Sheet5.Range("f2").Text
    End If

'   Filter by Gauge

    If Sheet5.Range("f3").Value <> "" Then
        .AutoFilter field:=7, Criteria1:="<=" & Sheet5.Range("f3").Value
    End If
    If Sheet5.Range("f3").Value <> "" Then
        .AutoFilter field:=8, Criteria1:=">=" & Sheet5.Range("f3").Value
    End If

'   Filter by Width

    If Sheet5.Range("f4").Value <> "" Then
        .AutoFilter field:=9, Criteria1:="<=" & Sheet5.Range("f4").Value
    End If

'   Filter by Max Weight

    If Sheet5.Range("f6").Value <> "" Then
        .AutoFilter field:=6, Criteria1:=">=" & Sheet5.Range("f6").Value
    End If

'   Filter by Length

    If Sheet5.Range("f5").Value <> "0" Then
        .AutoFilter field:=11, Criteria1:=">=" & Sheet5.Range("f5").Value
    End If


End With

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

Вот текстовый пример списка инвентаря 

TagNo   Class   Gauge   Width   Length  Wgt 
383891  GALV    0.0274  55.125  0       10140
389763  GALV    0.0277  46.102  0       33382
392471  HRPO    0.1026  8.5     0       4420
395949  CRFH    0.1235  59.736  0       45760
416268  HR      0.067   51.8262 0       36760
416897  CR      0.0197  1.5354  0       7482
416898  CR      0.0197  1.5354  0       6782
416899  CR      0.0197  1.5354  0       6712
416900  CR      0.0197  1.5354  0       7528
416901  CR      0.0197  1.5354  0       6790
416902  CR      0.0197  1.5354  0       6764

Здесь Пример списка номеров деталей: 

INDEX   Customer    PartNumber      PartDesc                    MaterialType    MaxWgt  MinGage MaxGage Width   WidthTolerance  Length 
1       B1          .0138 X 2.161"  CR .0150 X 2.161            CR              3500    0.0142  0.0165  2.161   +/- 0.006       0
15      E1          .050 X 2.995    .050 X 2.995"               HR              3363    0.05    0.058   2.995   +/- 0.005       0
27      C1          04518G48        HD G60 CTD .045M X 48 X C   GALV            18000   0.044   0.049   48.124  -3              0

И для наглядности, как изображения

Пример списка инвентаря

Пример таблицы номеров деталей и спецификации

Ответы [ 2 ]

1 голос
/ 31 января 2020

Оказывается, использование MATCH INDEX для каждого из критериев работало очень эффективно. Вместо того, чтобы циклически проходить инвентаризацию, он смог оценить каждый параметр и отобразить значение, если все условия выполнялись. Спасибо за помощь!

0 голосов
/ 30 января 2020

Проверьте это, а также проверьте правильность введенных вами правил. В отправленных вами файлах нет совпадений ... 

Private Sub InventoryInterpretation()
 Dim strFoldPath As String, w As Workbook, wInv As Workbook, shI As Worksheet
 Dim wSpec As Workbook, shS As Worksheet, boolInv As Boolean, boolSpec As Boolean
 Dim strSpec As String, strInv As String, arrInv As Variant, arrSp As Variant, arrRez() As String
 Dim i As Long, s As Long, strclass As String

  strFoldPath = "Your folder path"
  strSpec = strFoldPath & "\" & "Specification1.txt" 'user your file name
  strInv = strFoldPath & "\" & "Inventory1.txt"      'user your file name

  For Each w In Workbooks 'check if the necessary .txt/.csv files are opened in Excel:
    If w.FullName = strSpec Then Set wSpec = w: boolSpec = True
    If w.FullName = strInv Then Set wInv = w: boolInv = True
  Next
  If Not boolInv Then
    If Dir(strInv) <> "" Then 'check if file exists
      Set wInv = Workbooks.Open(strInv)
    Else
      MsgBox "No Inventory file in folder """ & strFoldPath & """.": Exit Sub
    End If
  End If
  If Not boolSpec Then ' if the spec file is not opened in Excel
      If Dir(strSpec) <> "" Then 'check if file exists
        Set wSpec = Workbooks.Open(strSpec)
      Else
        MsgBox "No Specification file in folder """ & strFoldPath & """.": Exit Sub
      End If
  End If
  Set shI = wInv.Sheets(1): Set shS = wSpec.Sheets(1)
  arrInv = shI.Range("A1").CurrentRegion.Value: ' Debug.Print UBound(arrInv, 1), UBound(arrInv, 2)
  arrSp = shS.Range("A1").CurrentRegion.Value: 'Debug.Print UBound(arrSp, 1), UBound(arrSp, 2)
  ReDim arrRez(UBound(arrInv, 1))
  'Making the real job:
  shI.Cells(1, UBound(arrInv, 2) + 2).EntireColumn.Clear ' clear the column where data are returned
  For i = 2 To UBound(arrInv, 1)
    strclass = arrInv(i, 3) 'col 3 of inventory array
    For s = 2 To UBound(arrSp, 1)
        If arrSp(s, 6) = strclass Then
            Stop
            If CDbl(arrInv(i, 4)) >= CDbl(arrSp(s, 8)) And _
                    CDbl(arrInv(i, 4)) <= CDbl(arrSp(s, 9)) And _
                    CDbl(arrInv(i, 5)) >= CDbl(arrSp(s, 10)) And _
                     CDbl(arrInv(i, 7)) <= CDbl(arrSp(s, 7)) Then
                arrRez(i) = "OK - " & strclass: Exit For
            Else
                Debug.Print CDbl(arrInv(i, 4)) >= CDbl(arrSp(s, 8))
                Debug.Print CDbl(arrInv(i, 4)) <= CDbl(arrSp(s, 9))
                Debug.Print CDbl(arrInv(i, 5)) >= CDbl(arrSp(s, 10))
                Debug.Print CDbl(arrInv(i, 7)) <= CDbl(arrSp(s, 7))
                arrRez(i - 1) = "No" & " - " & i: Exit For
            End If
        End If
    Next s
  Next i

  shI.Range(shI.Cells(1, UBound(arrInv, 2) + 2), shI.Cells(UBound(arrInv, 1), _
                    UBound(arrInv, 2) + 2)).Value = WorksheetFunction.Transpose(arrRez)
  wInv.Activate: shI.Activate
End Sub

Пожалуйста, используйте код в качестве вдохновения и для целей обучения ... Он соблюдает установленные вами правила, но между двумя этими данными не существует совпадений файлы. Пожалуйста, пересмотрите файлы или правила.

И дайте мне знать, что из вышеприведенных предположений соответствует действительности ...

...