重复单元A，如果列包含数据，Excel的VBA

Question

我是按以下格式数据

CardMinder 5 4.1   
Citrix Authentication Manager 6 5.1 7 8 5 
Citrix Receiver Inside 4.2 4.1 4.3 4.4 4 

我试图多次以每次写一些代码，将借此和添加的第一列之后的列。

例

CardMinder 5 
CardMinder 4.1 

我有一定的工作代码，但它一次只能工作在一行，并增加了多个空行中的行之间，如果我跑了两次。我不确定我做错了什么。

您的帮助表示赞赏。

Sub createVersions() 
Dim sheet As Worksheet 
Set sheet = ActiveSheet 


'Loop through columns in Excel sheet 
Dim LastRow As Long, LastCol As Integer, c As Integer, r As Long 

LastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).row 
LastCol = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column 


    For r = 1 To LastRow 
     If (LastCol > 2) Then 
     'Check column 3 to end for contents 
     For c = 3 To LastCol 
      rngParent = sheet.Cells(r, "A").Value 
      initChild = sheet.Cells(r, c).Value 

       If (initChild <> "") Then 
        'insert a row for extra column data 
        ActiveCell.EntireRow.Insert Shift:=xlShiftDown 
        sheet.Cells(r + 1, "A").Value = rngParent 
        sheet.Cells(r + 1, "B").Value = initChild 
       End If 
      Next c 
     End If 
    Next r 
End Sub 

Answer 1

从我明白你只是想获得有从下面该项目在每列数第一列该项目的每一个组合两列的列表。在数据集中可以做到这一点，但老实说，如果我们将它写入新的工作表中，它就简单多了。只需对现有代码进行一些小的修改即可完成此操作。

Sub createVersions() 
Dim sheet As Worksheet 
Set sheet = ActiveSheet 

'Use a new sheet instead of messing with the base data 
Dim wsVersionList As Worksheet 
Set wsVersionList = ThisWorkbook.Sheets.Add 

'Loop through columns in Excel sheet 
Dim LastRow As Long, LastCol As Integer, c As Integer, r As Long 

LastRow = sheet.UsedRange.Rows(sheet.UsedRange.Rows.Count).Row 
LastCol = sheet.UsedRange.Columns(sheet.UsedRange.Columns.Count).Column 

Dim CurRow As Long 
CurRow = 1 

For r = 1 To LastRow 
    If (LastCol > 2) Then 
    'Check column 2 to end for contents 
     For c = 2 To LastCol 
     rngParent = sheet.Cells(r, "A").Value 
     initChild = sheet.Cells(r, c).Value 

      If (initChild <> "") Then 
       'Write the software and verison values into the scratch sheet 
       wsVersionList.Cells(CurRow, 1) = rngParent 
       wsVersionList.Cells(CurRow, 2) = initChild 
       'Increment to the next row 
       CurRow = CurRow + 1 
      End If 
     Next c 
     End If 
Next r 

End Sub