Excel中的宏在一個單元格中停止

我是 VBA 新手，遇到了一個小問題。這是我的代碼：

Sub my_first_macro()
    Range("D4") = "My text Here"
    Range("I4") = "1"
    Range("D5").Select
End Sub

這個宏的想法是有一個與之關聯的按鈕

• 這會將單元格 D4 填充為“我的文本此處”，并將 I4 填充為“1”。

• 當我第二次點擊時，它會用“我的文字在這里”填充單元格 D5，用“1”填充 J4。

• 然后，當我第三次點擊時，它會用“我的文本在這里”填充單元格 D6，用“1”填充 K4。

• 然后，當我第四次點擊時，它會用“我的文本在這里”和 L4 用“1”填充單元格 D7。

這真的很簡單，但我無法解決這個問題。

有什么幫助嗎？

uj5u.com熱心網友回復：

要將當前選定單元格的值設為“1”并選擇其下方的單元格，您可以執行以下操作：

Sub my_macro()
    Selection.Value = "1"
    Selection.Offset(1, 0).Select
End Sub

uj5u.com熱心網友回復：

同時移動行和列

• 修改cCell和rCell范圍以查看其靈活性。

Option Explicit

Sub my_first_macro()
    
    Dim cCell As Range: Set cCell = Range("D4")
    Dim rCell As Range: Set rCell = Range("I4")
    
    Dim cfRow As Long: cfRow = cCell.Row
    Dim cCol As Long: cCol = cCell.Column
    
    Dim rRow As Long: rRow = rCell.Row
    Dim rfCol As Long: rfCol = rCell.Column
    
    Dim cLastRow As Long: cLastRow = Cells(Rows.Count, cCol).End(xlUp).Row
    Debug.Print cLastRow, cfRow
    
    If cLastRow < cfRow Then
        cCell.Value = "My text Here"
        rCell.Value = "1"
    Else
        Cells(cLastRow   1, cCol).Value = cCell.Value
        Cells(rRow, cLastRow   rfCol - cfRow   1).Value = rCell.Value
    End If
    
End Sub

uj5u.com熱心網友回復：

一種可能的解決方案：我已經評論了我的代碼。該解決方案不穩定。

Public Sub shift_text_and_numbers()

'Use lngCounter as static variable, that means it keeps its value under the following conditions
'1. if the sub is finished and called again and
'2. as long as there occurs no error in your vba-project and
'3. your workbook is open
    
    Static lngCounter As Long

'Provide your content here

    Dim strText As String: strText = "My text here"
    Dim lngNumber As Long: lngNumber = 1

'Set the first cell for each shift

    Dim rngStartCellText As Range: Set rngStartCellText = Worksheet1.Range("D4")
    Dim rngStartCellNumber As Range: Set rngStartCellNumber = Worksheet1.Range("I4")
    
'Check, whether the required rows and columns are full of data
    
    If _
        rngStartCellText.Row   lngCounter > Worksheet1.Rows.Count Or _
        rngStartCellNumber.Column   lngCounter > Worksheet1.Columns.Count _
    Then

'If the rows and columns are full of data, leave this routine

        Exit Sub
        
    End If
    
'Calculates the next cell depending on lngCounter and the first cells, represents also your sheme

    Dim rngNextCellText As Range: Set rngNextCellText = Worksheet1.Cells(rngStartCellText.Row   lngCounter, rngStartCellText.Column)
    Dim rngNextCellNumber As Range: Set rngNextCellNumber = Worksheet1.Cells(rngStartCellNumber.Row, rngStartCellNumber.Column   lngCounter)

'Check, whether there is already the required data in the next cell

    If _
        rngNextCellText.Value = strText Or _
        rngNextCellNumber.Value = lngNumber _
    Then

'Count up for the next call

        lngCounter = lngCounter   1
 
'If there is already the data, repeat the routine

        shift_text_and_numbers

'Check, whether the next cells are already filled with data
'Avoids overwriting of data

    ElseIf _
        VBA.Len(rngNextCellText.Value) > 0 Or _
        VBA.Len(rngNextCellNumber.Value) > 0 _
    Then
    
'If the next cells contain data, leave the routine

        Exit Sub
    
    Else

'Write the content in the next cells

        rngNextCellText.Value = strText
        rngNextCellNumber.Value = lngNumber

'Count up for the next call

        lngCounter = lngCounter   1
    
    End If
    
End Sub

感謝@VBasic2008 學習了一種宣告可愛變數的新方法。

標籤：擅长 vba

上一篇：壓縮“If陳述句”中的重復代碼

下一篇：C#將List<object>粘貼到Excel列中而無需回圈