VBA 매크로 셀 내용을 기반으로 셀을 새로운 시트 Excel로 이동시키는 VBA 매크로

Question

나는 내가 필요로하는 구체적인 응답을 찾을 수 없었습니다. 그래서 나는 물어볼 것이다. C 럼 A에서만 데이터가있는 시트 (Sheet1)가 있습니다.이 값은 다음과 같습니다.

ID, TITL 및 AUTH가 포함 된 모든 셀에 대해 A 열에서 검색하는 VBA 매크로를 만들어야합니다. 다른 시트 (Sheet2)의 특정 열로 이동하십시오. Sheet2에는 ID, 제목 및 작성자가 3 개의 열이 있습니다.

셀의 데이터를 Sheet2의 특정 열로 복사하는 것과 함께 데이터의 첫 번째 부분도 삭제해야합니다. 예 : ID : Sheet1의 R564838은 "ID :"없이 Sheet2의 ID 열로 이동해야합니다. R564838 만 이동해야합니다. 또한 "titl :"및 "auth :"복사 할 때 제거해야합니다.

이것이 의미가 있기를 바랍니다. 나는 단지 vba 매크로를 배우고 있습니다. 그래서 나는 이것을 어떻게 성취하는지 전혀 모른다.

업데이트

이 코드가 있습니다 :

Sub MoveOver() 

Cells(1, 1).Activate 


While Not ActiveCell = "" 

    If UCase(Left(ActiveCell, 4)) = "  ID" Then Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = _ 
    Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell))) 'Move ID to Col A in sheet 2

    If UCase(Left(ActiveCell, 4)) = "TITL" Then Sheets(2).Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = _ 
    Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell))) 'Move TITL to Col B in sheet 2

    If UCase(Left(ActiveCell, 4)) = "AUTH" Then Sheets(2).Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = _ 
    Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell))) 'Move AUTH to Col C in sheet 2

    ActiveCell.Offset(1, 0).Activate 

Wend 

.

end sub

와 그것이 작동합니다. 그러나 Sheet1에는 비어있는 일부 인증과 Titl이 있습니다. 그리고이 상황은 이것이 실행될 때, 인증이나 Titl이 비어있을 때마다 빈 셀을 남겨 두지 않는다는 것입니다. 인증이나 Titl이 비어 있으므로 정보가 각 책에 대해 일치하는 경우 빈 셀을 남기는 매크로가 필요합니다. 내 문제를 이해하기를 바랍니다.

다시 감사합니다!

Answer 1

오른쪽 통합 문서 / 시트 / 컬럼

에서 작업하고 있는지 확인하려면 일부 변수를 설정하십시오.

Set wb = ThisWorkbook
Set ws1 = wb.Sheets(1)
Set ws2 = wb.Sheets(2)
col = 1

.

열의 마지막 셀 찾기

last1 = ws1.Cells(ws1.Rows.Count, col).End(xlUp).Row

.

각 셀을보고해야 할 일을 알아낼 수 있습니다

For x = 1 To last1
    'What you do with each cell goes here
Next x

.

셀의 내용을 평가합니다 (특정 무언가가 포함 된 경우 알고 있음)

If ws1.Cells(x, col) Like "*ID:*" Then
    'What you do with a cell that has "ID:" in it
End If

.

셀의 관심 내용을 추출합니다 ( "헤더 제거")

myID = Mid(ws1.Cells(x, col), InStr(ws1.Cells(x, col), "ID:") + Len("ID:"))

.

다음의 사용 가능한 두 번째 시트에 콘텐츠를 놓습니다 (ID가 열 1로 가정)

current2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row + 1
ws2.Cells(current2, 1) = myID

.

코드 비트를 함께 모으고 정확한 요구에 맞게 조정하는 방법을 알아보십시오!

---

귀하의 의견에 대한 답변 :

기본적으로, 그렇습니다. 그러나 특정 상황을 완전히 포괄적으로 포괄적이지 않으므로 어떤 문제가 발생할 수 있습니다. 당신이해야 할 일은 다음과 같습니다.

1. 가변에서 ID를 저장합니다.
2. 타이틀 및 저자에 대해 동일하게하십시오.
3. 구분 된 줄을 찾으면 변수의 현재 내용을 다음 사용 가능한 행에 쓰고 해당 변수의 내용을 비우십시오.

예 :

If ws1.cells(x, col) Like "*----*" Then
    current2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row + 1
    ws2.Cells(current2, 1) = myID
    ws2.Cells(current2, 2) = myTitle
    ws2.Cells(current2, 3) = myAuthor
    myID = ""
    myTitle = ""
    myAuthor = ""
End If

.

---

여기에 가십시오 :)

Sub MoveOver() 

Cells(1, 1).Activate 

myId = ""
myTitle = ""
myAuthor = ""

While Not ActiveCell = ""

    If UCase(Left(ActiveCell, 4)) Like "*ID*" Then myId = Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell)))

    If UCase(Left(ActiveCell, 4)) = "TITL" Then myTitle = Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell)))

    If UCase(Left(ActiveCell, 4)) = "AUTH" Then myAuthor = Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell)))

    If ActiveCell Like "*---*" Then
        'NOW, MOVE TO SHEET2!
        toRow = Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
        Sheets(2).Cells(toRow, 1) = myId
        Sheets(2).Cells(toRow, 2) = myTitle
        Sheets(2).Cells(toRow, 3) = myAuthor
        myId = ""
        myTitle = ""
        myAuthor = ""
    End If

    ActiveCell.Offset(1, 0).Activate

Wend

.

내가 바뀐 것을 이해하는 데 도움이 필요하면 알려 주시기 만하면 똑바로 앞으로 나아갈 것입니다!

Answer 2

A : 분리기로서 열로 텍스트를 수행하려고 할 수도 있습니다.1 대신 2 개의 열에 대한 정보를 제공 한 다음 헤더의 한 열을 검색하고 다음 열 값, 공백 또는 그렇지 않으면 다음 열 값을 복사 할 수 있습니다.