excel 匹配不同列中的值,并将匹配项放置在单独的列中,VBA?

0kjbasz6  于 2023-08-08  发布在  其他
关注(0)|答案(2)|浏览(144)

这就是目前的数据。列sku具有~2K行。列image具有~ 8 k行。我删除了图像文件名的文件扩展名和前导零,所以我可以更容易地匹配。
x1c 0d1x的数据
大部分的图像都不需要,只有第一场比赛是我需要的。所以你在上面的例子中看到,列sku/image之间有一个匹配-- function将在中间列中传递值。
所需的结果如下所示,请注意05099.jpg&05103.jpg存在于image列中:



我在SO上得到了另一个人的帮助,他们提供了这个函数,但是字典没有填充中间列的值。我完全搞不懂为什么,一开始是有效的。

  1. Function getSKUFromFilename(filename As String) As Long
  2. getSKUFromFilename = Val(filename)
  3. End Function
  4. Sub FillImageNames()
  5. Dim ws As Worksheet, imageArr()
  6. Set ws = ThisWorkbook.Worksheets("Sheet1")
  7. imageArr = ws.Range("C2:C" & ws.Cells(ws.Rows.Count, "A").End(xlUp).row)
  8. ' (1) Fill Dictionary
  9. Dim d As New Dictionary
  10. Dim row As Long
  11. For row = 1 To UBound(imageArr, 1)
  12. Dim filename As String, sku As Long
  13. filename = Trim(imageArr(row, 1))
  14. If filename <> "" Then
  15. sku = getSKUFromFilename(filename)
  16. d(sku) = filename
  17. End If
  18. Next
  19. ' (2) Fill sheet
  20. Dim lastRow as Long
  21. lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).row
  22. For row = 2 To lastRow
  23. sku = Val(ws.Cells(row, 1))
  24. If d.Exists(sku) Then
  25. ws.Cells(row + 1, 2) = d(sku)
  26. End If
  27. Next
  28. End Sub

字符串

3phpmpom

3phpmpom1#

匹配转换数据


的数据

Excel公式

  1. =IFNA(INDEX(C2:C8,MATCH(A2:A6,
  2. VALUE(LEFT(C2:C8,FIND(".",C2:C8)-1)),0)),"Nope")

个字符

VBA

  1. Function GetSkuFromImageName(ByVal Imagename As String) As Long
  2. GetSkuFromImageName = Val(Imagename)
  3. End Function
  4. Sub MatchImageNames()
  5. Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
  6. Dim srrg As Range: ' Source Return Range
  7. Set srrg = ws.Range("C2", ws.Cells(ws.Rows.Count, "C").End(xlUp))
  8. Dim sData(): sData = srrg.Value ' assuming more than one cell
  9. Dim sDict As Object: Set sDict = CreateObject("Scripting.Dictionary")
  10. Dim r As Long, sNumber As Long, sString As String
  11. For r = 1 To UBound(sData, 1)
  12. sString = CStr(sData(r, 1))
  13. sNumber = GetSkuFromImageName(sString)
  14. If sNumber > 0 Then
  15. If Not sDict.Exists(sNumber) Then ' ensuring first match
  16. sDict(sNumber) = sString
  17. End If
  18. End If
  19. Next r
  20. ' The keys of the dictionary hold the lookup data (numbers)
  21. ' while the corresponding items hold the return data (strings):
  22. Erase sData
  23. Dim dlrg As Range: ' Destination Lookup Range
  24. Set dlrg = ws.Range("A2", ws.Cells(ws.Rows.Count, "A").End(xlUp))
  25. Dim dData(): dData = dlrg.Value ' assuming more than one cell
  26. Dim dValue, IsFound As Boolean
  27. For r = 1 To UBound(dData, 1)
  28. dValue = dData(r, 1)
  29. If VarType(dValue) = vbDouble Then ' is a number
  30. If sDict.Exists(dValue) Then
  31. IsFound = True
  32. End If
  33. End If
  34. ' Using the same array for the results.
  35. If IsFound Then
  36. dData(r, 1) = sDict(dValue)
  37. IsFound = False
  38. Else
  39. dData(r, 1) = "Nope" ' or Empty, or...
  40. End If
  41. Next r
  42. Dim drrg As Range: ' Destination Return Range
  43. Set drrg = dlrg.EntireRow.Columns("B")
  44. drrg.Value = dData
  45. MsgBox "Image names matched.", vbInformation
  46. End Sub

展开查看全部
b09cbbtk

b09cbbtk2#

本质上,您希望比较一组值对,如果这些值对相等,则将一些信息写入工作表。
您提到您正在处理大量数据,因此我建议将数据存储在一个数组中,完成所有查找匹配项的工作,然后将所有内容写回工作表。这比在Excel中逐行比较要快得多。
下面是一个简单的例子:


的数据

  1. Private Sub FillMatches()
  2. ' Store data in an array
  3. Dim RangeData As Range
  4. Set RangeData = ThisWorkbook.Sheets("Sheet1").Range("A2:D4")
  5. Dim ArrayImageInfo()
  6. ArrayImageInfo() = RangeData.Value
  7. ' Iterate through data and check for matches
  8. Dim ii As Long
  9. For ii = 1 To UBound(ArrayImageInfo, 1)
  10. If ArrayImageInfo(ii, 1) = ArrayImageInfo(ii, 3) Then
  11. ArrayImageInfo(ii, 2) = ArrayImageInfo(ii, 4)
  12. End If
  13. Next ii
  14. ' Write the data back to the sheet
  15. RangeData.Value = ArrayImageInfo
  16. End Sub

字符串
结果是:


展开查看全部

相关问题