将选择移动到 excel vba 中各自列的底部
Move selection to their respective column's bottom in excel vba
如果我有 5 列 (A-F) 中的数据并且我 select 这些列中的不同单元格,我想要一个宏将这些单元格的内容移动到它们各自的列第 12 行。
例如:A3,B2,B4,C4,D1,D2,F4
这些内容应该到A12,B12,C12,D12,F12,用“,”隔开。
这几乎可以完成工作,但如果我 select 来自超过 1 列的东西,它就不起作用:
Sub Move()
Dim selectedCells As Range
Dim rng As Range
Dim i As Integer
Dim values() As String
Dim CSV As String
Set selectedCells = Selection
ReDim values(selectedCells.Count - 1)
i = 0
For Each rng In selectedCells
values(i) = CStr(rng.Value)
i = i + 1
Next rng
CSV = Join(values, ", ")
Dim vArr
vArr = Split(Selection.Address(True, False), "$")
SC = vArr(0)
Range(SC & "12").Value = CSV
Selection.ClearContents
End Sub
提前感谢您的帮助!
不鼓励使用 Selection
,但如果您想采用这种方法,像这样的方法怎么样?
Sub Move()
Dim selectedCells As Range
Dim rng As Range
Dim targetRng As Range
Set selectedCells = Selection
For Each rng In selectedCells
Set targetRng = Cells(12, rng.Column)
If IsEmpty(targetRng) Then
targetRng = rng
Else
targetRng = targetRng & ", " & rng
End If
rng.ClearContents
Next rng
End Sub
另一种可能性:
Sub Move()
Dim cell As Range, cell2 As Range
For Each cell In Selection
With Cells(12, cell.Column)
If IsEmpty(.Value) Then
For Each cell2 In Intersect(.EntireColumn, Selection)
.Value = .Value & " " & cell2.Value
Next
.Value = Join(Split(Trim(.Value), " "), ",")
End If
End With
Next
Selection.ClearContents
End Sub
如果我有 5 列 (A-F) 中的数据并且我 select 这些列中的不同单元格,我想要一个宏将这些单元格的内容移动到它们各自的列第 12 行。
例如:A3,B2,B4,C4,D1,D2,F4 这些内容应该到A12,B12,C12,D12,F12,用“,”隔开。
这几乎可以完成工作,但如果我 select 来自超过 1 列的东西,它就不起作用:
Sub Move()
Dim selectedCells As Range
Dim rng As Range
Dim i As Integer
Dim values() As String
Dim CSV As String
Set selectedCells = Selection
ReDim values(selectedCells.Count - 1)
i = 0
For Each rng In selectedCells
values(i) = CStr(rng.Value)
i = i + 1
Next rng
CSV = Join(values, ", ")
Dim vArr
vArr = Split(Selection.Address(True, False), "$")
SC = vArr(0)
Range(SC & "12").Value = CSV
Selection.ClearContents
End Sub
提前感谢您的帮助!
不鼓励使用 Selection
,但如果您想采用这种方法,像这样的方法怎么样?
Sub Move()
Dim selectedCells As Range
Dim rng As Range
Dim targetRng As Range
Set selectedCells = Selection
For Each rng In selectedCells
Set targetRng = Cells(12, rng.Column)
If IsEmpty(targetRng) Then
targetRng = rng
Else
targetRng = targetRng & ", " & rng
End If
rng.ClearContents
Next rng
End Sub
另一种可能性:
Sub Move()
Dim cell As Range, cell2 As Range
For Each cell In Selection
With Cells(12, cell.Column)
If IsEmpty(.Value) Then
For Each cell2 In Intersect(.EntireColumn, Selection)
.Value = .Value & " " & cell2.Value
Next
.Value = Join(Split(Trim(.Value), " "), ",")
End If
End With
Next
Selection.ClearContents
End Sub