EXCEL VBA循環的問題?

excel vba

pi4da4 2017-12-08 22:41:17 ‧ 9675 瀏覽

分享至

Sub 產生器()
'
' Macro3 Macro
'

'
Range("D1").Select
Application.CutCopyMode = False
Selection.Copy
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'
If Range("B1") > 0 Then
Range("B1").Select
Application.CutCopyMode = False
Selection.Copy
Range("F1").Select
ActiveSheet.Paste
Range("D1").Select
Application.CutCopyMode = False
Selection.Copy
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End If

If Range("B2") > 0 Then
Range("B2").Select
Application.CutCopyMode = False
Selection.Copy
Range("F1").Select
ActiveSheet.Paste
Range("D1").Select
Application.CutCopyMode = False
Selection.Copy
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End If

If Range("B3") > 0 Then
Range("B3").Select
Application.CutCopyMode = False
Selection.Copy
Range("F1").Select
ActiveSheet.Paste
Range("D1").Select
Application.CutCopyMode = False
Selection.Copy
Range("C3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End If

If Range("B4") > 0 Then
Range("B4").Select
Application.CutCopyMode = False
Selection.Copy
Range("F1").Select
ActiveSheet.Paste
Range("D1").Select
Application.CutCopyMode = False
Selection.Copy
Range("C4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End If

If Range("B5") > 0 Then
Range("B5").Select
Application.CutCopyMode = False
Selection.Copy
Range("F1").Select
ActiveSheet.Paste
Range("D1").Select
Application.CutCopyMode = False
Selection.Copy
Range("C5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End If
End Sub

我希望B與C欄位可以逐次+1循環下去，"F1"及"D1"維持固定不變
假設到儲存格B999開始是空白的，再把這個循環停止，有辦法用變數或loop的方式把她解決嗎??
然後如果之後B1500才開始出現空白可以繼續使用這個程式碼

謝謝~拜託了

登入發表討論

直播研討會

{{ item.channelVendor }} {{ item.webinarstarted }} |

直播中

1 個回答

海綿寶寶

iT邦大神 1 級 ‧ 2017-12-11 22:51:32

最佳解答

Sub Macro3()
    '複製 D1 到 C1
    Range("C1").Value = Range("D1").Value
    
    '設定初值
    bRun = True
    Range("B1").Select
    '主要迴圈
    Do While bRun
        '只要是空白就停止執行
        If IsEmpty(ActiveCell.Value) Then
            bRun = False
            Exit Do
        End If
        '若當時的儲存格值 > 0
        '1.將當時儲存格的值複製到 F1
        '2.將 D1 的值 複製到 當時儲存格的隔壁欄(Cnnn)
        If (ActiveCell.Value > 0) Then
            Range("F1").Value = ActiveCell.Value
            ActiveCell.Offset(0, 1).Value = Range("D1").Value
        End If
        ActiveCell.Offset(1, 0).Select
    Loop
    '執行完成
    MsgBox "Done", vbInformation
End Sub