我想为多列中的重复项编写一个Excel VBA。

huangapple
go评论98阅读模式
英文:

I would like to write an Excel VBA for the repeated itmes for several columns

问题

以下是代码部分的翻译：

  1. Sub repeat_items()
  3. '----变量
  4. Dim lrow_d As Long
  5. Dim lrow_s As Long
  7. '-----工作表
  8. Dim s_sht As Worksheet
  10. '-----定义工作表名称
  11. Set s_sht = Worksheets("Repeat")
  13. '--最后一行
  14. lrow_s = s_sht.Cells(Rows.Count, 1).End(xlUp).Row
  16. '---创建重复项
  17. s_sht.Range("D2:D1000000").Clear
  19. For i = 2 To lrow_s   '从上到下计算第2列A的数量
  21. lrow_d = s_sht.Cells(Rows.Count, 4).End(xlUp).Row
  23. s_sht.Range("A" & i).Copy Destination:=s_sht.Range("D" & lrow_d + 1 & ":" & "D" & lrow_d + s_sht.Range("B" & i))
  24. ' +1是底部下一行，D是列D的位置，B是从列B计算的次数
  26. Next i
  28. End Sub

希望这个翻译对您有帮助。如果您有任何其他问题，请随时提出。

英文:

I would like to know how to write the excel VBA for this repeated items as shown in the photo?
The left is the data I have, and the right is the target answer I want to achieve.
I tried to find the code for that but it is in vain, could anyone please help? thanks.

我想为多列中的重复项编写一个Excel VBA。

  1. Sub repeat_items()
  3. '----variables
  4. Dim lrow_d As Long
  5. Dim lrow_s As Long
  7. '-----Sheets
  8. Dim s_sht As Worksheet
  10. '-----Define Sheet names
  11. Set s_sht = Worksheets("Repeat")
  13. '--LastRow
  14. lrow_s = s_sht.Cells(Rows.Count, 1).End(xlUp).Row
  17. '---Creating repeating
  18. s_sht.Range("D2:D1000000").Clear
  20. For i = 2 To lrow_s         'count no. 2 of column A from up to down
  22. lrow_d = s_sht.Cells(Rows.Count, 4).End(xlUp).Row
  24. s_sht.Range("A" & i).copy Destination:=s_sht.Range("D" & lrow_d + 1 & ":" & "D" & lrow_d + s_sht.Range("B" & i))
  25.             '+1 is bottom next row      'D is the column D location         'B is calculating number of times from column B
  27. Next i
  29. End Sub

答案1

得分: 0

基于您提供的屏幕截图，以下内容应该适用于您。请确保根据需要更新工作表名称，并根据需要调整目标位置。（如果要将结果放在不同的工作表上，需要添加一个新的工作表变量）。

  1. Sub repeat_items()
  2.     
  3.     '声明和设置变量
  4.     Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
  5.     Dim rData As Range: Set rData = ws.Range("A1").CurrentRegion
  6.     Dim rDest As Range: Set rDest = ws.Range("H2")
  7.     If rData.Rows.Count = 1 Then Exit Sub '没有数据
  8.     Dim aData As Variant: aData = rData.Value
  9.     
  10.     '准备结果数组
  11.     Dim aResults() As Variant, iResult As Long
  12.     ReDim aResults(1 To WorksheetFunction.Sum(rData), 1 To 1)
  13.     
  14.     '准备循环变量
  15.     Dim i As Long, j As Long, k As Long, sResult As String
  16.     
  17.     '循环遍历每一行
  18.     For i = 2 To UBound(aData, 1)
  19.         sResult = vbNullString '将结果字符串重置为空
  20.         
  21.         '循环遍历每一列
  22.         For j = 1 To UBound(aData, 2)
  23.             
  24.             '检查数据中的值是否为数字
  25.             If Not IsNumeric(aData(i, j)) Then
  26.                 '不是数字，使用"_"将文本添加到结果字符串
  27.                 sResult = sResult & aData(i, j) & "_"
  28.             Else
  29.                 '这是一个数字，循环该数字次数
  30.                 For k = 1 To aData(i, j)
  31.                     '每次都将此列标题添加到结果字符串并追加到结果数组
  32.                     iResult = iResult + 1
  33.                     aResults(iResult, 1) = sResult & aData(1, j)
  34.                 Next k
  35.             End If
  36.         Next j
  37.     Next i
  38.     
  39.     rDest.Resize(rDest.CurrentRegion.Rows.Count).ClearContents
  40.     rDest.Resize(UBound(aResults, 1)).Value = aResults '输出结果
  41.     
  42. End Sub
英文:

Based off your provided screenshot, something like this should work for you. Be sure to update worksheet name as necessary, and adjust the destination if you want it elsewhere. (Would need to add a new worksheet variable if you want the destination on a different sheet).

  1. Sub repeat_items()
  2.     
  3.     'Declare and set variables
  4.     Dim ws As Worksheet:    Set ws = ThisWorkbook.Worksheets("Sheet1")
  5.     Dim rData As Range:     Set rData = ws.Range("A1").CurrentRegion
  6.     Dim rDest As Range:     Set rDest = ws.Range("H2")
  7.     If rData.Rows.Count = 1 Then Exit Sub  'No data
  8.     Dim aData As Variant:   aData = rData.Value
  9.     
  10.     'Prepare results array
  11.     Dim aResults() As Variant, iResult As Long
  12.     ReDim aResults(1 To WorksheetFunction.Sum(rData), 1 To 1)
  13.     
  14.     'Prepare loop variables
  15.     Dim i As Long, j As Long, k As Long, sResult As String
  16.     
  17.     'Loop through each row
  18.     For i = 2 To UBound(aData, 1)
  19.         sResult = vbNullString      'Reset the result string to null
  20.         
  21.         'Loop through each column
  22.         For j = 1 To UBound(aData, 2)
  23.             
  24.             'Check if the value in the data is a number or not
  25.             If Not IsNumeric(aData(i, j)) Then
  26.                 'Not a number, add the text to the result string with an "_"
  27.                 sResult = sResult & aData(i, j) & "_"
  28.             Else
  29.                 'This is a number, loop that number of times
  30.                 For k = 1 To aData(i, j)
  31.                     'Each time, add this column header to the result string and append it to the results array
  32.                     iResult = iResult + 1
  33.                     aResults(iResult, 1) = sResult & aData(1, j)
  34.                 Next k
  35.             End If
  36.         Next j
  37.     Next i
  38.     
  39.     rDest.Resize(rDest.CurrentRegion.Rows.Count).ClearContents
  40.     rDest.Resize(UBound(aResults, 1)).Value = aResults  'Output results
  41.     
  42. End Sub

huangapple
  • 本文由 发表于 2023年3月7日 23:16:43
  • 转载请务必保留本文链接：https://go.coder-hub.com/75663822.html
  • excel
  • vba
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定