将值从单独的合并单元格复制到一个合并单元格中，作为以逗号分隔的坐标

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