將值從單獨的合并單元格復制到一個合并單元格中，作為以逗號分隔的坐標

我是 VBA 的初學者。我試圖將資料從 1 個作業簿復制到另一個作業簿，特別是從 2 個合并單元格到 1 個合并單元格的資料作為坐標。

Cell 1 = 58.634
Cell 2 = 63.458
Destination Cell = 58.634, 63.458

而且我還需要反向執行操作，例如：從由逗號分隔的坐標單元格中??檢索各個值，并將它們粘貼到 2 個單獨（合并）的單元格中。

截至目前，我的代碼僅由多個單元格上的一系列簡單的資料復制/粘貼組成。多行：

Workbooks("Origin file.extension").Worksheets("sheet1").Range(" ").Copy
Workbooks("Destination file.extension").Worksheets("sheet1").Range("  ").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

uj5u.com熱心網友回復：

我已經評論了代碼。如果您還有問題，請告訴我？

這是你正在嘗試的嗎？（未經測驗）

Option Explicit

Sub Sample()
    Dim wbOrigin As Workbook
    Dim wbDest As Workbook
    
    '~~> Change this to the relevant workbooks
    Set wbOrigin = Workbooks("Origin file.extension")
    Set wbDest = Workbooks("Destination file.extension")
    
    Dim wsOrigin As Worksheet
    Dim wsDest As Worksheet
    
    '~~> Change this to the relvant worksheets
    Set wsOrigin = wbOrigin.Sheets("Sheet1")
    Set wsDest = wbDest.Sheets("Sheet1")
    
    Dim rngOriginMergedOne As Range
    Dim rngOriginMergedTwo As Range
    Dim rngMergedDest As Range
    
    '~~> Change these to the relevant merged cells
    Set rngOriginMergedOne = wsOrigin.Range("A1")
    Set rngOriginMergedTwo = wsOrigin.Range("D1")
    Set rngMergedDest = wsDest.Range("A1")
        
    '~~> This is the delimiter
    Dim delim As String: delim = ", "
    
    '~~> Combining two values
    rngMergedDest.Value = rngOriginMergedOne.Value2 & delim & rngOriginMergedTwo.Value2
End Sub

相反，將rngMergedDest.Value = rngOriginMergedOne.Value2 & delim & rngOriginMergedTwo.Value2上面代碼中的行替換為下面的行。

'~~> The Reverse
rngOriginMergedOne.Value = Split(rngMergedDest.Value2, delim)(0)
rngOriginMergedTwo.Value = Split(rngMergedDest.Value2, delim)(1)

uj5u.com熱心網友回復：

也許我遺漏了一些東西，所以只是為了確保在 POC 下假設所有資料都在作業表 1 col A 中。如果這符合您的要求，我將添加外部作業簿等：

    Sub merge()
        Dim arr, st, LastRow As Long
        With Sheet1
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'count rows from last row
            arr = .Range(.Cells(1, 1), .Cells(LastRow, 1)).Value2 'load col A of invoices
        End With
        
        st = WorksheetFunction.Transpose(arr)
        st = Join(st, ",")
        Sheet1.Range("D1") = st
    End Sub
    Sub Unmerge()
        Dim arr, st, LastRow As Long
        With Sheet1
            arr = Split(.Range("D1"), ",")
            .Range(.Cells(1, 5), .Cells(UBound(arr), 5)) = WorksheetFunction.Transpose(arr) 'dump updated array to customer sheet
        End With
    End Sub

uj5u.com熱心網友回復：

有趣的方式來做到這一點，因為已經有了答案。

Sub CopyMergedCells()

Dim WrkBStart, WrkBDest As Workbook
Dim WrkSheet1, WrkSheet2 As Worksheet
Dim StartRng, EndRng, DestRng As Range
Dim delim As String: delim = ", "
Dim FirstDest, SecondDest, DestToMerge, MergedString As Variant

'Set workbooks
Set WrkBStart = Workbooks("1st WorkBook")
Set WrkBDest = Workbooks("2nd WorkBook")
'Set WorkSheets
Set WrkSheet1 = WrkBStart("1st WorSheet")
Set WrkSheet2 = WrkBDest("2nd WorkSheet")

'Determine what cells you want
'Start
FirstDest = Application.InputBox(prompt:="Enter 1st Cell", Type:=2)
SecondDest = Application.InputBox(prompt:="Enter 2nd Cell", Type:=2)
'Destination
DestOfCopy = Application.InputBox(prompt:="Enter Destination Cell", Type:=2)

'Copy From Start Location
ToCopy1 = Worksheets("Sheet2").Range(FirstDest).Value
ToCopy2 = Worksheets("Sheet2").Range(SecondDest).Value
MergedString = ToCopy1 & ", " & ToCopy2

'Paste To End location
Worksheets("Sheet2").Range(DestOfCopy).Select
Selection.UnMerge
Worksheets("Sheet2").Range(DestOfCopy).Select
Selection.Value = MergedString
DestToMerge = ActiveCell.Offset(0, 1).address
Range(DestOfCopy, DestToMerge).Select

'DestRng.Select
Selection.Merge

End Sub

標籤：擅长 vba

上一篇：將列與范圍進行比較并在VBA中的多個作業表之間洗掉

下一篇：只為表格中的行著色，而不是所有行