Excel中的宏在一个单元格中停止

Question

我是 VBA 新手，遇到了一个小问题。这是我的代码：

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

这个宏的想法是有一个与之关联的按钮

• 这将在单元格 D4 中填充“我的文本”，在 I4 中填充“1”。

• 当我第二次点击时，它会在单元格 D5 中填充“我的文本”，在 J4 中填充“1”。

• 然后，当我第三次点击时，它会在单元格 D6 中填充“我的文本”，在 K4 中填充“1”。

• 然后，当我第四次点击时，它会在单元格 D7 中填充“我的文本”和在 L4 中填充“1”。

这真的很简单，但我无法解决这个问题。

有什么帮助吗？

Answer 1

要将当前选定单元格的值设为“1”并选择其下方的单元格，您可以这样做：

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

Answer 2

同时移动行和列

• 修改 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

Answer 3

一种可能的解决方案：我已经注释了我的代码。

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 学习了一种声明变量可爱的新方法。