iT邦幫忙

0

EXCEL VBA循環的問題?

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 }} |
{{ formatDate(item.duration) }}
直播中

1 個回答

0
海綿寶寶
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

我要發表回答

立即登入回答