[英]Copy values from seperate merged cells into one merged cell as coordinates seperated by a comma
I am a beginner in VBA.我是 VBA 的初学者。 I am trying to copy data from 1 workbook to another, specifically data from 2 merged cells into 1 merged cell as coordinates.
我试图将数据从 1 个工作簿复制到另一个工作簿,特别是从 2 个合并单元格到 1 个合并单元格的数据作为坐标。
Cell 1 = 58.634
Cell 2 = 63.458
Destination Cell = 58.634, 63.458
And I also need to do the operation in reverse, as in: retrieve the individual values from the coordinates cell seperated by a comma and paste them into 2 seperate (merged) cells.而且我还需要反向执行操作,例如:从由逗号分隔的坐标单元格中检索各个值,并将它们粘贴到 2 个单独(合并)的单元格中。
As of right now, my code simply consists of a succession of simple copy/paste of data over multiple cells.截至目前,我的代码仅由多个单元格上的一系列简单的数据复制/粘贴组成。 Multiple lines of this:
多行:
Workbooks("Origin file.extension").Worksheets("sheet1").Range(" ").Copy
Workbooks("Destination file.extension").Worksheets("sheet1").Range(" ").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
I have commented the code.我已经评论了代码。 Let me know if you still have a question?
如果您还有问题,请告诉我?
Is this what you are trying?这是你正在尝试的吗? ( UNTESTED )
(未经测试)
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
For the reverse, replace the line rngMergedDest.Value = rngOriginMergedOne.Value2 & delim & rngOriginMergedTwo.Value2
in the above code with the below lines.相反,将上面代码中的
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)
Maybe I'm missing something so just to be sure hereunder a POC assuming all data is in sheet 1 col A. If this does what you want I'll add the external workbook etc:也许我遗漏了一些东西,所以只是为了确保在 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
Fun Way to do it since there are answers already.有趣的方式来做到这一点,因为已经有了答案。
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.