Question

我的数据看起来如下表所示。此数据集中的观察数量每个月都不同。列保持不变。我想在每行循环我的代码，直到该行为空。我认为while循环是合适的，但到目前为止我还没有成功执行它（注意，我是一个完整的VBA新手。）

其他一些注意事项：代码贯穿每次数据观察时唯一会改变的是第2行中选择的范围（我想向下移动到下一行观察）并选择最终范围对于代码最后一行中的Paste Special步骤（同样，我希望在每次迭代时向下移动到下一行观察）。

Sample Data:
Sex   Age Race    Total Cholesterol   HDL-Cholesterol Systolic Blood Pressure Treatment for High Blood Pressure   Diabetes    Smoker  
F 50  AA  300 90  200 Y   Y   Y   
M 55  AA  290 90  200 Y   Y   Y   
F 50  AA  300 90  200 N   N   N

我需要遍历每个非空行的代码：

Sub ASCVD()

    Sheets("Sheet1").Select
    Range("A2:I2").Select
    Selection.Copy
    Sheets("Omnibus").Select
    Range("C3").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("B13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet1").Select
    Range("J2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


End Sub

非常感谢您的帮助!!!

Answer 1

创建所需最终结果的示例，目前还不清楚您想要实现的目标。（现在你只描述了一堆实现，而不是大图）

无论如何，我假设您要做的就是转置您的数据，此代码完成工作：

Sub ASCVD()

    Dim Data() As Variant
    Dim nrow As Integer

    Data() = ThisWorkbook.Sheets("Sheet1").Range("A1").CurrentRegion.Value
    nrow = UBound(Data(), 1)

    ThisWorkbook.Sheets("Omnibus").Activate
    DoEvents 
    'Previous two lines needed so that the .Range(Cells(3.3), ... part works below

    ThisWorkbook.Sheets("Omnibus").Range(Cells(3, 3), Cells(16 + 2, nrow + 2)) = Application.WorksheetFunction.Transpose(Data()) 
    'Cells(rownumber, columnnumber). Cells(1,1) is cell A1
    'Cells(3, 3) is same as cell C3.
    'Cells(16 + 2, nrow + 2) in your example case will be cell F18, the last cell of your data.
    '+2 because you want to start from C3, meaning all your data is shifted two cells down and two cells right

End Sub

Answer 2

第二个想法，你真正要问的是如何使用Do While循环：

Sub ASCVD()

    Dim row As Integer
    row = 2

    Do While ThisWorkbook.Sheets("Sheet1").Cells(row, 1) <> "" 'Loop until first cell is empty

        ThisWorkbook.Sheets("Sheet1").Range("A" & row & ":I" & row).Select
        Selection.Copy
        Sheets("Omnibus").Select
        Range("C3").Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
        Range("B13").Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("Sheet1").Select
        Range("J" & row).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False

        row = row + 1
    Loop


End Sub

代码循环抛出行2,3,4,5 ......并在找到第一个单元格为空的行时停止

在VBA中执行while循环

2 个答案: