拨开荷叶行,寻梦已然成。仙女莲花里,翩翩白鹭情。
IMG-LOGO
主页 文章列表 Excel中的宏在一个单元格中停止

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

白鹭 - 2022-02-13 2245 0 0

我是 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热心网友回复:

同时移动行和列

  • 修改cCellrCell范围以查看其灵活性。
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 学习了一种宣告可爱变量的新方法。

标签:

0 评论

发表评论

您的电子邮件地址不会被公开。 必填的字段已做标记 *