VBA Macro per spostare le cellule su un nuovo foglio di foglio in base al contenuto della cella

Question

Guardo intorno e non riuscivo a trovare la risposta specifica di cui ho bisogno. Quindi chiederò. Ho un foglio (foglio1) con i dati solo sulla colonna A. Sembra questo:

E ho bisogno di creare una macro VBA che cerca nella colonna A per qualsiasi cella che contiene ID, TITL e AUTH. E spostali in una colonna specifica in un altro foglio (foglio2). Sheet2 avrà 3 colonne: ID, titolo e autore.

La cosa è che insieme a copiare i dati della cella nella sua colonna specifica in foglio2, ha anche bisogno di eliminare la prima parte dei dati. Per esempio: ID: R564838 in foglio1 deve essere spostato nella colonna ID in foglio2, senza "ID:" in esso. Quindi solo R564838 dovrebbe essere spostato. Anche "Titl:" e "Auth:" dovrebbe essere rimosso quando copiato.

Spero che questo abbia senso. Sto solo imparando le macro di VBA. Quindi non ho idea di come realizzarlo.

Aggiornamento

Ho questo codice:

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 funziona. Ma ci sono alcuni Auth e Titl in Sheet1 che sono vuoti. E la situazione è che quando questo funziona, non lascia una cella vuota quando Auth o Titl è vuota. Ho bisogno della macro per lasciare una cella vuota se AUTH o TITL è vuoto in modo che le informazioni corrispondano per ogni libro. Spero tu capisca il mio problema.

Grazie ancora!

Answer 1

Imposta alcune variabili per assicurarti di lavorare sulla cartella di lavoro / foglio / colonna

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

.

Trova l'ultima cella della colonna

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

.

Guarda ogni cella per capire cosa fare con esso

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

.

Valuta il contenuto della cella (sapere se contiene qualcosa di specifico)

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

.

Estrarre il contenuto di interesse della cella (rimuovere l'intestazione ")

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

.

Posiziona il contenuto nella successiva riga disponibile del secondo foglio (supponendo ID va in colonna 1)

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

.

Scopri come mettere insieme i bit del codice e adattarlo alle tue esigenze esatte!

---

.

In risposta al tuo commento:

Fondamentalmente, sì, ma potresti imbattersi in qualche problema in quanto non è pienamente completa della tua situazione particolare. Quello che potresti dover fare è:

.
1. Conservare l'ID (una volta trovato uno) in una variabile;
2. fai lo stesso per il titolo e l'autore;
3. Una volta trovata una linea di delimitazione, si scrive invece il contenuto corrente delle variabili alla prossima linea disponibile e svuota il contenuto di tali variabili.

Ad esempio:

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

.

---

.

Qui 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 hai bisogno di aiuto per capire quello che ho cambiato, fammi sapere, ma dovrebbe essere piuttosto semplice!

Answer 2

Potresti anche provare a fare un testo alla colonna con A: come separatore.Ciò darebbe le tue informazioni in 2 colonne anziché 1, è possibile cercare una colonna per l'intestazione e copiare il valore successivo della colonna, vuoto o in altro modo.