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

根据我的理解，您只是想获得一个两列列表，其中包含第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

如果列包含数据，则复制单元格A，Excel VBA

1 个答案: