重複單元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