我是新來的。我希望您幫助合并兩個選定行的值。首先,我將選擇在每個單元格中包含值的 2 行。我希望第二行單元格中的每個值移動到第一行中的單元格,然后第二行中的單元格將為空。我嘗試了一個 VBA,但結果使所有文本合并到一個單元格中并用分號分隔。這是我一直在嘗試的:
Sub ConcatenateCellsToActiveCell_Semicolon()
Dim rngCell As Range
Dim rngActive As Range
Dim strTemp As String
Set rngActive = Selection
strTemp = ""
For Each rngCell In rngActive
strTemp = strTemp & rngCell.Value
strTemp = strTemp & "; "
'rngCell.Value = "" 'Uncomment to clear selected, non-active cells
Next
ActiveCell.Value = Left(strTemp, Len(strTemp) - 2)
Set rngActive = Nothing
End Sub
這是我想要實作的插圖:
- https://ibb.co/HzCr3JN << 這是開始
- https://ibb.co/wSx2TwZ <<這是我想要的結果
這是我嘗試過的 VBA 的結果 https://ibb.co/DzCKCvf
謝謝你的幫助。
uj5u.com熱心網友回復:
文本加入第一行
- 調整常量部分中的值。
- 在您選擇一個范圍并運行子程式后,使用給定的分隔符,每列的值將連接到列的第一個單元格中,并且可以選擇清除其他行中的值。
單范圍解決方案(連續)
Sub JoinFirstInRow()
Const Delimiter As String = " "
Const ClearOtherRows As Boolean = True
Const Title As String = "Join in First Row"
Dim ash As Object: Set ash = ActiveSheet
If ash Is Nothing Then Exit Sub ' no visible workbooks open
If Not TypeOf ash Is Worksheet Then Exit Sub ' not a worksheet
If Not TypeOf Selection Is Range Then Exit Sub ' not a range
Dim rg As Range: Set rg = Selection
Dim TextJoined As Boolean
TextJoined = TextJoinInFirstRow(rg, Delimiter, ClearOtherRows, Title)
If Not TextJoined Then Exit Sub
'rg.EntireColumn.AutoFit
MsgBox "Text joined in first row (" & rg.Rows(1).Address(0, 0) & ").", _
vbInformation, Title
End Sub
Function TextJoinInFirstRow( _
ByVal rg As Range, _
Optional ByVal Delimiter As String = " ", _
Optional ByVal ClearOtherRows As Boolean = True, _
Optional ByVal Title As String = "Microsoft Excel") _
As Boolean
With rg.Areas(1)
Dim srCount As Long: srCount = .Rows.Count
If srCount = 1 Then
MsgBox "Cannot join one row.", vbExclamation, Title
Exit Function
End If
Dim sData() As Variant: sData = .Value
Dim drCount As Long: drCount = IIf(ClearOtherRows, srCount, 1)
Dim cCount As Long: cCount = .Columns.Count
Dim dData() As String: ReDim dData(1 To drCount, 1 To cCount)
Dim sr As Long
Dim c As Long
Dim dr As Long
Dim cString As String
For c = 1 To cCount
cString = CStr(sData(1, c))
For sr = 2 To srCount
cString = cString & Delimiter & CStr(sData(sr, c))
Next sr
dData(1, c) = cString
Next c
.Resize(drCount).Value = dData
End With
TextJoinInFirstRow = True
End Function
多范圍解決方案(非連續)
Sub JoinFirstInRow()
Const Delimiter As String = " "
Const ClearOtherRows As Boolean = True
Dim ash As Object: Set ash = ActiveSheet
If ash Is Nothing Then Exit Sub ' no visible workbooks open
If Not TypeOf ash Is Worksheet Then Exit Sub ' not a worksheet
If Not TypeOf Selection Is Range Then Exit Sub ' not a range
Dim rg As Range: Set rg = Selection
TextJoinInFirstRow rg, Delimiter, ClearOtherRows
End Sub
Sub TextJoinInFirstRow( _
ByVal rg As Range, _
Optional ByVal Delimiter As String = " ", _
Optional ByVal ClearOtherRows As Boolean = True)
Dim arg As Range
Dim sData() As Variant
Dim dData() As String
Dim drCount As Long
Dim cCount As Long
Dim sr As Long
Dim c As Long
Dim dr As Long
Dim dString As String
For Each arg In rg.Areas
Dim srCount As Long: srCount = arg.Rows.Count
If srCount > 1 Then
sData = arg.Value
drCount = IIf(ClearOtherRows, srCount, 1)
cCount = arg.Columns.Count
ReDim dData(1 To drCount, 1 To cCount)
For c = 1 To cCount
dString = CStr(sData(1, c))
For sr = 2 To srCount
dString = dString & Delimiter & CStr(sData(sr, c))
Next sr
dData(1, c) = dString
Next c
arg.Resize(drCount).Value = dData
End If
Next arg
End Sub
轉載請註明出處,本文鏈接:https://www.uj5u.com/ruanti/514478.html
標籤:擅长vba