Excel：將值複製到特定行的VBA

Question

我目前有一個宏，它可以從一個工作表（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 
a  b  4 
c  d  6 

第2步（宏執行後）：

c1 c2 c3 
a  b  4 
c  d  6 
c  d  5 

但我需要一個新功能是否這樣：

步驟2（指定「c」的C1值，宏執行）：

c1 c2 c3 
a  b  4 
c  d  5 

Answer 1

看看這是怎麼回事。不知道你是如何打電話等，但它應該是一個合理的起點。我只給了它一個非常快速測試

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中的值進行比較。如果它發現它取代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 

讓我知道這對你的作品。