Macro per Excel: Se la Colonna B è “X”, quindi copiare tutta la riga e incolla nel Foglio di lavoro denominato “Colonna B”

Mi sono limitata esperienza di scrittura di macro, e sto cercando di aggiornare un foglio di calcolo corrente utilizzato al lavoro. Attualmente siamo in copia l’intero Master foglio di lavoro e incollarlo in altri fogli di lavoro prima di ordinare per la “X” in alcune colonne per eliminare le altre righe sul master foglio di lavoro.

Quello che sto cercando di fare è di ricerca, Master Foglio, e se la Colonna B è una “X”, quindi copiare l’intera riga e incolla in un foglio di lavoro denominato “Colonna B”. Poi, una volta che la Colonna B è stato completato e incollato, a Colonna D. Se la Colonna D era una “X”, per copiare l’intera riga e incollarlo nella scheda del foglio di lavoro denominato “Colonna D”.

Grazie in anticipo!

  • Domande. (1) dati per essere aggiunto al foglio di lavoro “Colonna B” o sono le righe esistenti per essere eliminato per primo? (2) È “X”, l’esatto valore nelle colonne B e D o questa una scorciatoia per valori diversi? (3) Cosa succede se c’è una X in entrambe le colonne B e d (4) È il Maestro del foglio di lavoro di essere lasciato invariato?
  • Io non sono sicuro perché è stato dato credito per il riordino della domanda. Excellll fatto tutto il lavoro duro.
  • (1) L’intera riga dove “X” è nella Colonna B è quello di copiare e incollare nel Foglio di lavoro “Colonna B”. Nulla da eliminare. Che può essere fatto in seguito. (2) “X” è l’esatto valore in queste colonne. (3) Se c’è una “X” nella Colonna B e D, allora vorrei che il tutto copiato e incollato in entrambi Foglio di lavoro “Colonna B” Foglio di lavoro “Colombo D”. (4) Sì, il Master foglio di lavoro rimane invariata. Grazie
InformationsquelleAutor Mark Berlin | 2012-03-01



2 Replies
  1. 1

    Approccio

    Io dovrebbe essere incluso nella prima versione della mia risposta.

    La mia soluzione dipende dal filtro automatico. I primi offrono un play che dimostra questo approccio:

    1. fare le righe che non contengono X nella colonna B invisibile
    2. fare le righe che non contengono X nella colonna D invisibile
    3. rimozione del filtro automatico

    Se questo approccio appello, vi rimando alla mia risposta ad un’altra domanda che crea un menu in modo che l’utente può selezionare il filtro desiderato.

    Se questo approccio non fa appello, offro una seconda soluzione, che comporta la copia di righe visibili a sinistra da ogni filtro ad altri fogli di lavoro.

    Introduzione

    Si dice “ho limitato esperienza di scrittura di macro”, che prendo a dire che hai una certa esperienza. Spero di avere il livello di spiegazioni corrette. Tornare con le domande, se necessario.

    Presumo che la cartella di lavoro è su un server. Presumo che qualcuno ha accesso in scrittura per aggiornare il master foglio di lavoro, mentre altri aprono copie di sola lettura in modo che possano guardare al sottoinsiemi di loro interesse. Se le mie ipotesi sono sulla destra, prendere una copia della cartella di lavoro per voi a giocare con. Non preoccuparti per gli altri, l’aggiornamento, la versione originale della cartella di lavoro, bisogna copiare la versione finale del codice dalla versione di gioco quando abbiamo finito.

    Passo 1

    Copia il primo blocco di codice in un modulo all’interno del gioco. Vicino alla parte inferiore potrai trovare Const WShtMastName As String = "SubSheetSrc". Sostituire SubSheetSrc con il nome del tuo padrone foglio di lavoro.

    Nota: la macro all’interno di questo blocco sono denominati CtrlCreateSubSheetB e CreateSubSheetB perché sono versioni di gioco. La vera versioni denominate CtrlCreateSubSheet e CreateSubSheet.

    Eseguire macro CtrlCreateSubSheetB. Si vedrà il Maestro foglio di lavoro, ma solo le righe con una “X” nella colonna B. fare Clic sulla casella di messaggio.Si vedrà il Maestro foglio di lavoro, ma solo le righe con una “X” nella colonna d). fare Clic sulla casella di messaggio e il filtro scompare. Interruttore per l’Editor di VB se non ci siete già. Nella Finestra Immediata (Clic Ctrl+G se non è visibile) e vedrete qualcosa di simile a:

    Rows with X in column 2: $A$1:$G$2,$A$4:$G$5,$A$8:$G$9,$A$11:$G$12,$A$14:$G$14, ...
    Rows with X in column 4: $A$1:$G$1,$A$3:$G$3,$A$5:$G$5,$A$7:$G$7,$A$10:$G$10, ...

    Ora di lavoro macro CtrlCreateSubSheetB e CreateSubSheetB. È necessario capire come questi macro hanno creato gli effetti che hai visto. Se necessario, utilizzare VB Aiuto, il Debugger e F8 a scendere le macro per identificare ciò che ogni istruzione sta facendo. Credo di aver dato abbastanza informazioni, ma di tornare con le domande, se necessario.

    ' Option Explicit means I have to declare every variable.  It stops
    ' spelling mistakes being taken as declarations of new variables.
    Option Explicit
    
    ' Specify a subroutine with two parameters
    Sub CreateSubSheetB(ByVal WShtSrcName As String, ByVal ColSrc As Long)
    
      ' This macro applies an AutoFilter based on column ColSrc
      ' to the worksheet named WShtSrcName
    
      Dim RngVis As Range
    
      With Sheets(WShtSrcName)
        If .AutoFilterMode Then
          ' AutoFilter is on.  Cancel current selection before applying
          ' new one because criteria are additive.
          .AutoFilterMode = False
        End If
    
        ' Make all rows which do not have an X in column ColSrc invisible
        .Cells.AutoFilter Field:=ColSrc, Criteria1:="X"
    
        ' Set the range RngVis to the union of all visible rows
        Set RngVis = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    
      End With
    
      ' Output a string to the Immediate window.
      Debug.Print "Rows with X in column " & ColSrc & ": " & RngVis.Address
    
    End Sub
    
    ' A macro to call CreateSubSheetB for different columns
    Sub CtrlCreateSubSheetB()
    
      Const WShtMastName As String = "SubSheetSrc"
    
      Dim WShtOrigName As String
    
      ' Save the active worksheet
      WShtOrigName = ActiveSheet.Name
    
      ' Make the master sheet active if it is not already active so
      ' you can see the different filtered as they are created.
      If WShtOrigName <> WShtMastName Then
        Sheets(WShtMastName).Activate
      End If
    
      ' Call CreateSubSheet for column 2 (=B) then column 4 (=D)
    
      Call CreateSubSheetB(WShtMastName, 2)
      Call MsgBox("Click to continue", vbOKOnly)
      Call CreateSubSheetB(WShtMastName, 4)
      Call MsgBox("Click to continue", vbOKOnly)
      With Sheets(WShtMastName)
        If .AutoFilterMode Then
          .AutoFilterMode = False
        End If
      End With
    
      ' Restore the original worksheet if necessary
      If WShtOrigName <> WShtMastName Then
        Sheets(WShtOrigName).Activate
      End If
    
    End Sub

    Passo 2

    Se la mia ipotesi su come utilizzare la cartella di lavoro sono corrette, non ha bisogno di molto di più. Se Giovanni e Maria aprire una lettura aprire copia del master cartella di lavoro di John potrebbe usare il B filtro mentre Maria si usa il D filtro. Se questo sembra interessante, guarda la mia risposta a copia riga di dati da un foglio di calcolo di uno o più fogli con valori di altre celle.

    Passo 3

    Se non ti piace l’idea di utilizzare solo filtri e ancora voglia di creare copie di il dato B e D di dati, è necessario il codice riportato di seguito.

    Le macro all’interno di questo blocco sono denominati CtrlCreateSubSheet e CreateSubSheet ma non sono molto diverse dalle versioni B di cui sopra.

    In CtrlCreateSubSheet sarà necessario sostituire “SubSheetSrc”, “SubSheetB” e “SubSheetD” con i vostri nomi per questi fogli di lavoro. Aggiungere ulteriori richieste di CreateSubSheet per qualsiasi ulteriore colonne di controllo.

    Nota: queste versione eliminare il contenuto originale dei fogli di destinazione anche se questo non è quello che hai chiesto. Ho cancellato il contenuto originale, in quanto (1) quello che hai aggiunta di nuove righe è più complicato e (2) non credo si siano corrette. Se c’è qualche significato di ciò che è richiesto per poi tornare e voglio aggiornare il codice.

    Option Explicit
    Sub CtrlCreateSubSheet()
    
      Const WShtMastName As String = "SubSheetSrc"
    
      ' Call CreateSubSheet for column 2 (=B) then column 4 (=D)
    
      Application.ScreenUpdating = False
    
      Call CreateSubSheet(WShtMastName, 2, "SubSheetB")
      Call CreateSubSheet(WShtMastName, 4, "SubSheetD")
      With Sheets(WShtMastName)
        If .AutoFilterMode Then
          .AutoFilterMode = False
        End If
      End With
    
      Application.ScreenUpdating = True
    
    End Sub
    Sub CreateSubSheet(ByVal WShtSrcName As String, ByVal ColSrc As Long, _
                        ByVal WShtDestName As String)
    
      ' This macro applies an AutoFilter based on column ColSrc to the worksheet
      ' named WShtSrcName. It then copies the visible rows to the worksheet
      ' named WShtDestName
    
      Dim RngVis As Range
      Dim WShtOrigName As String
    
      With Sheets(WShtSrcName)
        If .AutoFilterMode Then
          ' AutoFilter is on.  Cancel current selection before applying
          ' new one because criteria are additive.
          .AutoFilterMode = False
        End If
    
        ' Make all rows which do not have an X in column ColSrc invisible
        .Cells.AutoFilter Field:=ColSrc, Criteria1:="X"
    
        ' Set the range RngVis to the union of all visible cells
        Set RngVis = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    
      End With
    
      If RngVis Is Nothing Then
        ' There are no visible rows.  Since the header row will be visible even if
        ' there are no Xs in column ColSrc, I do not believe this block can
        ' be reached but better to be safe than sorry.
        Call MsgBox("There are no rows with an X in column " & ColSrc, vbOKOnly)
        Exit Sub
      End If
    
      ' Copy visible rows to worksheet named WShtDestName
    
      With Sheets(WShtDestName)
    
        ' First clear current contents of worksheet named WShtDestName
        .Cells.EntireRow.Delete
    
        ' Copy column widths to destination sheets
        Sheets(WShtSrcName).Rows(1).Copy
        .Rows(1).PasteSpecial Paste:=xlPasteColumnWidths
    
        ' I do not recall using SpecialPaste column widths before and it did not
        ' work as I expected.  Hunting around the internet I found a link to a   
        ' Microsoft page which gives a workaround.  This workaround worked in
        ' that it copied the column widths but it left row 1 selected.  I have
        ' added the following code partly because I like using FreezePanes and
        ' partly to unselect row 1.
        WShtOrigName = ActiveSheet.Name
        If WShtOrigName <> WShtDestName Then
          .Activate
        End If
        .Range("A2").Select
        ActiveWindow.FreezePanes = True
        If WShtOrigName <> WShtDestName Then
          Sheets(WShtOrigName).Activate
        End If
    
        ' Copy all the visible rows in the Master sheet to the destination sheet. 
        RngVis.Copy Destination:=.Range("A1")
    
      End With
    
    End Sub

    Passo 4

    Una volta deleveloped le macro per la vostra soddisfazione, è necessario copiare il modulo contenente la macro dalla tua versione di gioco per la versione master. È possibile esportare il modulo e poi importarlo, ma penso che il seguito è più facile:

    • Hanno sia il gioco e master versioni della cartella di lavoro aperta.
    • Creare un modulo vuoto nella versione master per tenere la macro.
    • Selezionare la macro nella versione di gioco, copiare l’area di lavoro e quindi incollare il modulo vuoto nella versione master.

    È necessario insegnare a chi è responsabile di aggiornare la versione master per eseguire la macro ogni volta che un significativo aggiornamento è completo. Si potrebbe utilizzare un tasto di scelta rapida o aggiungere la macro la barra degli strumenti per rendere la macro, facile da usare.

    Riepilogo

    Spero che abbia un senso. Non fare domande se necessario.

  2. 0

    Più semplicemente:

    Sub Columns()
        If WorkSheets("Sheet1").Range("B1") = x Then
            WorkSheets("Column B").Range("B2") = WorkSheets("Sheet1").Range("B2:B" & Rows.Count).End(xlup).Row
        End if
        If WorkSheets("Sheet1").Range("D1") = x Then
            WorkSheets("Column D").Range("D2") = WorkSheets("Sheet1").Range("D2:D" & Rows.Count).End(xlup).Row
        End if
    End Sub

Lascia un commento