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

Question

我是 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

Answer 1

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

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

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行替換為以下rngMergedDest.Value = rngOriginMergedOne.Value2 & delim & rngOriginMergedTwo.Value2行。

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

Answer 2

也許我遺漏了一些東西，所以只是為了確保在 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

Answer 3

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

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