我是 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 学习了一种宣告可爱变量的新方法。
0 评论