A macro do VBA para mover células para uma nova folha de cálculo do Excel com base no conteúdo de uma célula

Question

Eu olho em volta e não conseguiu encontrar a resposta específica que eu preciso.Então eu vou perguntar.Eu tenho uma folha (folha1) com dados apenas na coluna A.Ele se parece com isso:

E o que eu preciso para criar uma macro do VBA que procura em Uma coluna para qualquer célula que contém o ID, TITL, e AUTH.E movê-los para uma coluna específica em outra folha(plan2).Folha2 vai ter 3 colunas:ID, Título e Autor.

A coisa é que, juntamente com a cópia dos dados da célula para a sua coluna específica na planilha2, ele também precisa apagar a primeira parte dos dados.Por exemplo:IDENTIFICAÇÃO:R564838 na folha1 precisa ser movido para a coluna ID na planilha2, sem o "ID:" nele.Assim, apenas R564838 precisa ser movido.Também "TITL:" e "AUTH:" precisam ser removidos quando copiados.

Espero que isso faz sentido.Eu estou apenas aprendendo macros VBA.Então eu não tenho idéia de como fazer isso.

ATUALIZAÇÃO

Eu tenho este código:

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

E ele funciona.Mas há alguns AUTH e TITL na folha1 que estão em branco.E a situação é que, quando este é executado, ele não deixa uma célula vazia sempre que AUTH ou TITL estão em branco.Eu preciso do macro para deixar uma célula vazia se AUTH ou TITL estão em branco assim que a informação corresponde, para cada livro.Eu espero que você entenda o meu problema.

Obrigado novamente!

Answer 1

Definir algumas variáveis para se certificar de que você está trabalhando no direito de livro/folha/coluna

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

Encontrar a última célula da coluna

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

Olhar para cada célula para descobrir o que fazer com ele

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

Avaliar o conteúdo da célula (Saber se ela contém algo específico)

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

Extrair o conteúdo de interesse da célula (remover o "cabeçalho")

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

Coloque o conteúdo na próxima linha disponível da segunda folha (supondo que o ID vai na coluna 1)

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

Descobrir como colocar os bits de código e adaptá-lo às suas necessidades!

---

Em resposta a seu comentário :

Basicamente, sim, mas você pode esbarrar em alguns problemas, como não é totalmente abrangente da sua situação particular.O que você pode fazer é :

1. Armazenar o ID (uma vez que você encontrar um) em uma variável;
2. Faça o mesmo para o título e autor;
3. Uma vez que você encontrar uma delimitação linha, em vez de escrever o conteúdo actual das variáveis para a próxima linha disponível e esvaziar o conteúdo dessas variáveis.

Por exemplo :

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

---

Aqui você vai :)

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

Se você precisa de ajuda para entender o que eu mudei, me avise, mas deve ser muito para a frente!

Answer 2

Você também pode querer tentar fazer um texto para a coluna com um :como o separador.Que iria fornecer suas informações, em 2 colunas em vez de 1 e, em seguida, você pode procurar uma coluna para o cabeçalho e copie o seguinte valor de coluna, em branco ou de outra forma.