2016-10-26 3 views
0

현재 한 시트 (BACKEND)의 특정 셀에서 값을 복사하고 다른 시트 (EXPORT_DATA)의 특정 열을 다음 빈 행에 붙여 넣는 매크로가 있습니다.Excel : 특정 행에 값을 복사하는 VBA

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 

그것은 잘 작동하지만, 나는 그것이 어디에서 셀의 행의 데이터를 붙여 넣 곳에서 함수에, 열에서 다음 빈 셀에 데이터를 붙여 넣 곳의 기능을 대체 할 지정된 값을 보유합니다. (매크로 실행 후)

c1 c2 c3 
a  b  4 
c  d  6 

2 단계 :이

예를 들어, 기존의 기능은 다음

단계를 할 것 1

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

그러나 나는 새로운 기능을 필요로하는 이 작업을 수행하십시오 :

2 단계 ("c"의 C1 값이 지정되고 매크로가 실행 됨) :

c1 c2 c3 
a  b  4 
c  d  5 
+0

현재 코드가 A 열의 마지막 값을 대체하는 것으로 보입니다. 이것을 알고 있습니까? 또한 A1 셀을 EXPORT_DATA 또는 전체 열에 복사하려고합니까? –

+0

@VBAPete 네 말이 맞아. 나는 잘못된 매크로를 붙여 넣었다. 업데이트 됨. 고마워! –

답변

1

어떻게되는지보십시오. 어떻게 당신이 등 전화하지만 확실한 출발점이어야합니다. 나는 단지이

여전히
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 
0

했다, 그러나 나는 이것이 당신이 후에 어떤 생각합니다. 이 파일은 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 

이 당신을 위해 작동하는지 알려주세요.

0

100 % 특정 일을 할 수 그것을 정말 빠른 테스트

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 
관련 문제