Makro für Excel: Wenn in Spalte B ein "X", dann kopieren Sie ganze Zeilen und fügen Sie im Arbeitsblatt mit dem Namen "Spalte B"

Ansatz

Ich hätte diese in der ersten version meiner Antwort.

Meine Lösung hängt davon ab, AutoFilter. Ich bieten zunächst einen play-Lösung, die diesen Ansatz veranschaulicht durch:

1. machen Zeilen mit X in Spalte B unsichtbar
2. machen Zeilen mit X in Spalte D unsichtbar
3. löschen der AutoFilter

Wenn Sie dieses Konzept anspricht, Verweise ich Sie auf meine Antwort auf eine andere Frage, schafft ein Menü, so kann der Benutzer auswählen, welche filter Sie wollen.

Wenn dieser Ansatz nicht ZUSAGT, biete ich eine zweite Lösung, die sich um das kopieren der sichtbaren Zeilen Links durch die einzelnen filter zu anderen Arbeitsblättern.

Einführung

Sagen Sie "begrenzt habe ich erfahren, schreiben von Makros", die ich nehmen an Sie bedeuten, dass Sie einige Erfahrung haben. Ich hoffe, ich habe das Niveau der Erklärungen richtig. Kommen Sie zurück mit Fragen, wenn nötig.

Ich davon aus, dass deine Arbeitsmappe liegt auf einem server. Ich nehme an, jemand hat schreib-Zugriff zum aktualisieren der master-Arbeitsblatt, während andere öffnen nur-lese-Kopien, so dass Sie Aussehen kann auf die Teilmengen von Interesse sind. Wenn meine Annahmen richtig, nehmen Sie eine Kopie der Arbeitsmappe für Sie zu spielen. Mach dir keine sorgen über andere, die Aktualisierung der master-version der Arbeitsmappe kopieren wir die endgültige version des Codes von deiner Spiel-version, wenn wir fertig sind.

Schritt 1

Kopieren Sie den ersten block von code zu einem Modul innerhalb der Spiel-version. In der Nähe der Unterseite finden Sie Const WShtMastName As String = "SubSheetSrc". Ersetzen SubSheetSrc durch den Namen des master-Arbeitsblatt.

Hinweis: die Makros in diesem block sind benannt CtrlCreateSubSheetB und CreateSubSheetB weil Sie spielen Versionen. Die echten Versionen sind benannt CtrlCreateSubSheet und CreateSubSheet.

Makro ausführen CtrlCreateSubSheetB. Sie werden sehen, die Master-Arbeitsblatt, sondern nur die Zeilen mit einem "X" in der Spalte B. Klicken Sie auf die message-box.Sie werden sehen, die Master-Arbeitsblatt, sondern nur die Zeilen mit einem "X" in Spalte D. Klicken Sie auf die message-box und der filter verschwinden. Wechseln Sie zu den VB-Editor, wenn Sie nicht bereits vorhanden sind. In das Direktfenster (Klicken Sie auf Ctrl+G wenn es nicht sichtbar ist) und Sie sehen etwas wie:

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, ...

Nun die Arbeit nieder Makros CtrlCreateSubSheetB und CreateSubSheetB. Sie müssen verstehen, wie diese makro erstellt haben, die Effekte, die Sie sah. Wenn notwendig, verwenden Sie die VB-Hilfe, Debugger und F8 zu Schritt nach unten, die Makros zu identifizieren, was jeder Anweisung zu tun. Ich glaube ich habe Euch genug Informationen, sondern kommen zurück mit Fragen, wenn nötig.

' 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

Schritt 2

Wenn meine Annahmen darüber, wie Sie verwenden die Arbeitsmappe korrekt sind, können Sie nicht viel mehr brauchen. Wenn John und Mary jeweils öffnen-Lesen-öffnen Sie die Kopie der master-Arbeitsmappe dann John konnte die B-filter, während Mary verwendet den D-filter. Wenn dies interessant klingt, schau in meine Antwort auf Sie Zeile kopieren von Daten von einem Blatt auf ein oder mehrere Blätter auf Grundlage der Werte in anderen Zellen.

Schritt 3

Wenn Sie nicht wie die Idee, nur mit Filter und immer noch wollen, um Kopien zu erstellen von den B-Daten-und der D-Daten, müssen Sie den code unten.

Die Makros in diesem block sind benannt CtrlCreateSubSheet und CreateSubSheet aber sind nicht viel anders als die B-Versionen vor.

In CtrlCreateSubSheet ersetzen Sie "SubSheetSrc", "SubSheetB" und "SubSheetD" mit Ihrem Namen für diese Arbeitsblätter. Fügen Sie weitere Anrufe von CreateSubSheet für jede weitere Kontrolle Spalten.

Hinweis: diese version löschen der ursprünglichen Inhalte des Ziel-sheets-dies ist zwar nicht das, was Sie gefragt haben. Ich habe gelöscht, den ursprünglichen Inhalt, da (1) das, was Sie haben, hinzufügen von neuen Zeilen ist komplizierter, und (2) ich glaube nicht, dass Sie korrekt sind. Wenn es einige Bedeutung zu, was Sie anzubieten dann kommen Sie zurück, und ich werde den code aktualisieren.

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

Schritt 4

Sobald Sie deleveloped die Makros zu Ihrer Zufriedenheit, müssen Sie kopieren Sie das Modul mit den Makros von deiner Spiel-version, um die master-version. Sie können das Modul exportieren und importieren Sie Sie dann, aber ich denke, das folgende ist einfacher:

• Haben beide die play-und master-Versionen der Arbeitsmappe öffnen.
• Ein leeres Modul erstellen, in der master-version halten Sie die Makros.
• Wählen Sie die Makros in die play-version, kopieren Sie Sie in den Zwischenspeicher und fügen Sie Sie in den leeren Modul in der master-version.

Müssen Sie lehren, wer ist verantwortlich für die Aktualisierung der master-version, um die Makros auszuführen, wenn ein wichtiges update abgeschlossen ist. Sie könnte verwenden Sie eine shortcut-Taste oder fügen Sie das makro auf die Symbolleiste, um das makro einfach zu bedienen.

Zusammenfassung

Hoffe, dass alle, die Sinn macht. Fragen Sie Fragen, wenn nötig.

InformationsquelleAutor Tony Dallimore