Question

我有一个Excel数据集，其中a列中有动物，b，c和d列中有数字。

我想找到一个vba代码，它将采用这个数据集并做两件事：将数字转换成一列，然后将相关动物的名称放入相邻的单元格中。如果您点击链接，表单1显示我拥有的数据集，表2显示我想要的数据集。

您可以在此处查看数据集：https://drive.google.com/file/d/0B8ss18LQyoQrdDVIQ2JMZmdPNVU/view?usp=sharing

这段代码会让我感到中途，但它并没有完全符合我的要求：

Sub moveandinsert()
Dim start_cell As Range
For i = 1 To 3
Set start_cell = Sheets("sheet1").Cells(i, 2)
Range(start_cell, start_cell.End(xlToRight)).Copy
   Sheets("Sheet2").Select
   lastRowA = Range("A" & Rows.Count).End(xlUp).Row + 1
   Range("A" & lastRowA).Select
       Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True

    For j = 1 To 12
        If Cells(j, 1).Value > 0 Then
        Sheets("Sheet1").Cells(i, 1).Copy
        Sheets("Sheet2").Cells(j, 2).Select
        Selection.PasteSpecial xlPasteAll
        j = j + 1
        End If
    Next j
Next i
End Sub`

任何帮助将不胜感激

Answer 1

尝试以下方法：

Sub moveandinsert()
Dim start_cell As Range
For i = 1 To 3
Set start_cell = Sheets("sheet1").Cells(i, 2)
Range(start_cell, start_cell.End(xlToRight)).Copy
Sheets("Sheet2").Select
lastRowA = Range("A" & Rows.Count).End(xlUp).Row + 1
Range("A" & lastRowA).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True


For j = lastRowA To lastRowA + 4
    If Cells(j, 1).Value > 0 Then
    Sheets("Sheet1").Cells(i, 1).Copy
    Sheets("Sheet2").Cells(j, 2).Select
    Selection.PasteSpecial xlPasteAll
    'j = j + 1
    End If
Next j
Next i
End Sub

1）j = j + 1不是必需的因为cuz j将在for循环中递增自身 2）你可以使用lastrowA作为粘贴的起点而不是硬编码为j = 1到12

vba使行单元格垂直并在第一列中重复值

1 个答案: