Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Spalten abgleichen

Betrifft: Spalten abgleichen von: Larissa
Geschrieben am: 28.09.2020 13:13:34

Hallo ihr Lieben,

ich habe folgendes Problem:

in Spalte Q habe ich verschiedene Projektnamen, die Projekte werden in den Spalten A bis G bestimmten Projektleitern zugeordnet.

Dabei müssen die Projekte nicht unbedingt in der gleichen Zeile den Projektleitern zugeordnet werden. Außerdem können auch mehrere Personen für ein Projekt zuständig sein. D.h. es ist möglich das Projekt in allen Spalten zu finden (aber verschiedene Zeilen).

Ich würde nun gerne mit VBA realisieren, dass wenn das Projekt in Zeile A bei Person A zu finden ist in Spalte R neben dem Projekt Namen ein X erscheint, um zu sehen dass das Projekt bereits für Person A zugewiesen wurde. Wenn das Projekt in Spalte A und B aufgeführt ist, soll in Spalte R und S ein X stehen.

Sehr hilfreich wäre auch der eine Fehlermeldung, wenn das Projekt doppelt in einer Spalte aufgeführt wurde.

Ich würde nur ungerne eine Formel verwenden, da oft Projekte gelöscht und neue eingefügt werden und dabei auch die Formeln gelöscht werden könnten.

Vielleicht habt ihr eine Idee wie ich einen solchen Code aufbauen muss.

Viele Grüße

Larissa

Betrifft: AW: Spalten abgleichen
von: fcs
Geschrieben am: 28.09.2020 14:30:14

Hallo Larissa,

mit dem folgenden Makro sollte es funktionieren.

LG
Franz
Sub Projekte_markieren()
  Dim rngProj As Range, rngProjekte As Range
  Dim wks As Worksheet
  Dim lngSpalte As Long
  Dim lngAnz As Long
  
  Set wks = ActiveSheet
  
  With wks
    'Zellbereich mit Projekten in Spalte Q
    Set rngProjekte = .Range(.Cells(2, 17), .Cells(.Rows.Count, 17).End(xlUp))
    'alte Markierungen löschen
    With rngProjekte
      .Offset(0, 1).Resize(.Rows.Count, 7).ClearContents
    End With
    'Projekte abarbeiten
    For Each rngProj In rngProjekte.Cells
      If rngProj <> "" Then
        For lngSpalte = 1 To 7 'Spalten A bis G
          lngAnz = Application.WorksheetFunction.CountIf(.Columns(lngSpalte), rngProj.Value)
          Select Case lngAnz
          Case 0 'Projekt steht nicht in Spalte
          Case 1 'Projek markieren
            rngProj.Offset(0, lngSpalte).Value = "X"
          Case Else 'Projekt ist in Spalte mehrfach eingetragen
            MsgBox "Das Projekt """ & rngProj.Value & """ steht " & lngAnz & " mal in Spalte "  _
_
              & Left(.Columns(lngSpalte).Address(False, False, xlA1), 1), vbOKOnly, _
              "Projekte suchen/markieren"
          End Select
        Next lngSpalte
      End If
    Next rngProj
  End With
  
End Sub


Betrifft: Funktioniert
von: Larissa
Geschrieben am: 28.09.2020 15:38:06

Hallo Franz,

Das ist genau das was ich wollte.
Ich danke dir!

Viele Grüße
Larissa