Excel：VBA将值复制到特定的行

我目前有一个macros从一个工作表（BACKEND）复制特定单元格的值，并粘贴到另一个工作表（EXPORT_DATA）的特定列中的下一个空白行中。

Sub copy_values(Optional Source As String = "A1", Optional Source2 As String = "A1") Dim R As Range Dim col As Long col = Range(Source).Column Set R = Worksheets("EXPORT_DATA").Cells(Rows.Count, col).End(xlUp) If Len(R.Value) > 0 Then Set R = R.Offset(1) R.Value = Worksheets("BACKEND").Range(Source2).Value End Sub 

它工作的很好，但是我想把一个列中下一个空白单元格中的数据粘贴到一个函数中，这个函数将一行中的数据粘贴到一个单元格保存指定值的地方。

例如，较旧的函数将执行以下操作

步骤1：

 c1 c2 c3 ab 4 cd 6 

步骤2（macros执行后）：

 c1 c2 c3 ab 4 cd 6 cd 5 

但是我需要一个新的function来做到这一点：

步骤2（指定“c”的C1值，macros执行）：

 c1 c2 c3 ab 4 cd 5 

Answer 1

看看这是怎么回事 不知道你是如何打电话等，但它应该是一个合理的起点。 我只给了它一个非常快速的testing

 Sub copy_values_SINGLE(cValue As Variant, Optional Source As String = "A1", Optional Source2 As String = "A1") ' Not sure of what value type c in your question would be but expects a single value to test against the column provided as Source ' Requires cValue to be provided Dim R As Range Dim col As Long Dim destRow As Integer col = Range(Source).Column On Error Resume Next destRow = 0 destRow = Worksheets("EXPORT_DATA").Columns(col).Find(cValue, SearchDirection:=xlPrevious).Row If destRow = 0 Then destRow = Worksheets("EXPORT_DATA").Cells(Rows.Count, col).End(xlUp).Row + 1 ' if cValue isnt found reverts to the last row as per previous code On Error GoTo 0 Set R = Worksheets("EXPORT_DATA").Cells(destRow, col) R.Value = Worksheets("BACKEND").Range(Source2).Value End Sub 

Answer 2

这可能工作

 Sub copy_values(Optional Source As String = "A1", Optional Source2 As String = "A1") Dim R As Variant Dim col As Long col = Range(Source).Column Dim mrn As String Dim FoundCell As Excel.Range Dim myVal As String R = Worksheets("BACKEND").Range(Source2).Text myVal = Worksheets("BACKEND").Range(Source2).Text mrn = Worksheets("BACKEND").Range("A5").Value Set FoundCell = Worksheets("EXPORT_DATA").Range("A:A").Find(what:=mrn, lookat:=xlWhole, searchdirection:=xlPrevious) If Not FoundCell Is Nothing Then ' MsgBox (R & " " & col & " " & FoundCell.Row) Worksheets("EXPORT_DATA").Range("Q" & FoundCell.Row).Value = R Else MsgBox "error" End If End Sub 

Answer 3

仍然不是100％肯定的，但我认为这是你以后的事情。 该文件循环EXPORT_DATA文件的列A中的所有值，并将它们与BACKEND工作表的单元格A1中的值进行比较。 如果find的值取代B列的值，如果找不到值，则在最后加上：

 Sub copy_values_SINGLE() Dim R As Range Dim rowCount As Long Dim varValue As Variant rowCount = Application.WorksheetFunction.CountA(Worksheets("EXPORT_DATA").Range("A:A")) For s = 1 To rowCount If Worksheets("EXPORT_DATA").Range("A" & s).Value = Worksheets("BACKEND").Range("A1").Value Then Worksheets("EXPORT_DATA").Range("A" & s & ":B" & s).Value = Worksheets("BACKEND").Range("A1:B1").Value Exit For Else If s = rowCount Then Set R = Worksheets("EXPORT_DATA").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) R.Value = Worksheets("BACKEND").Range("A1:B1").Value End If End If Next s End Sub 

让我知道这是否适合你。