2016-12-20 5 views
0

У меня есть данные, которые выглядят как таблица, показанная ниже. Количество наблюдений в этом наборе данных меняется каждый месяц. Столбцы остаются неизменными. Я бы хотел, чтобы цикл мой код через каждую строку, пока строка пуста. Я думаю, что цикл while будет уместным, но до сих пор мне не удалось его выполнить (отметим, что я полный новичок в VBA.)do while loop in VBA

Несколько других примечаний: Единственное, что изменится как код проходит через каждое наблюдение за данными - это диапазон, выбранный в строке 2 (я хочу перейти к следующей строке наблюдений) и конечный диапазон, выбранный для специального шага Вставить в последней строке кода (опять же, я захотят перейти к следующей строке наблюдений с каждой итерацией).

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 

Большое спасибо заранее за вашу помощь !!!

+0

htt p: //www.java2s.com/Code/VBA-Excel-Access-Word/Excel/DoUntilloopandIsEmpty.htm – cyboashu

+3

Эта [Документация Excel-VBA переполнения стека] (http://stackoverflow.com/documentation/excel-vba/ 918/methods-for-find-the-last-used-row-or-column-in-a-worksheet # t = 201612201616042176856) при поиске последней используемой строки поможет. После того, как вы получите последнюю строку, вы можете выполнить цикл от '3 до LastRow' –

ответ

0

Создайте пример желаемого конечного результата, это очень неясно, чего вы хотите достичь на данный момент. (Прямо сейчас вы только описывая беспорядок реализации, а не то, что большая картина)

Во всяком случае я предполагаю, что все, что вы хотите сделать, это перенести ваши данные, этот код делает работу:

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 
0

на второй мысли, что вы действительно спрашиваете, как использовать Do While Loop:

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 .... и останавливается, когда он находит строку, в которой первая ячейка пуста