Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.
Clever-Excel-Forum › Office-Anwendungen › Excel v
FormulaLocal vs. FormulaR1C1

Thema geschlossen 
Baumstrukturmodus
FormulaLocal vs. FormulaR1C1
BoskoBiati Offline
नौसिखिया [vidyaarthi]

Registriert seit: 13.04.2014
Version(en): 365, 2019
#21
19.10.2016, 14:03
Hallo Ralf,



ich habe mal was eingebaut in den Code für ein neues Projekt:


Code:
Sub neuesProjekt()
  '
  ' neuesProjekt anlegen
  '
  Dim loLetzte As Long
  Dim loA As Long
  Dim loB As Long
  Dim loErl As Long
  Dim loLae As Long
  Dim loAbg As Long
  Dim loWart As Long
  Dim loAnz As Long
  Dim rng As Range
 
  '
'   loZeile = ActiveCell.Row
Application.EnableEvents = False
  loLetzte = Sheets("Protokoll").Cells(Rows.Count, 4).End(xlUp).Row                     ' letzte belegte in Spalte D (4)
   For loA = 1 To loLetzte
       If (Cells(loA, 7) = "P") And (Cells(loA, 4) = "") Then
           If Not Range("G1:G" & loLetzte).Find("P", Cells(loA, 7)) Is Nothing Then
               loB = Range("G1:G" & loLetzte).Find("P", Cells(loA, 7)).Row
                If loB < loA Then loB = loLetzte + 1
           End If
           Debug.Print loA, loB
           loAnz = loB - loA
           Set rng = Range(Cells(loA + 1, 7), Cells(loB - 1, 7))
           
           loLae = Application.WorksheetFunction.CountIf(rng, "läuft")
           loErl = Application.WorksheetFunction.CountIf(rng, "erledigt")
           loAbg = Application.WorksheetFunction.CountIf(rng, "abgebrochen")
           loWart = Application.WorksheetFunction.CountIf(rng, "wartet")
           If loLae > 0 Then 'mindestens ein "läuft" => läuft
               Cells(loA, 4) = "läuft"
           ElseIf loErl = loAnz Then 'alle "erledigt" >= erledigt
               Cells(loA, 4) = "erledigt"
           ElseIf loAbg = loAnz Then 'alle abgebrochen >= abgebrochen
               Cells(loA, 4) = "abgebrochen"
           ElseIf loWart = loAnz Then 'alle "wartet" >= wartet
               Cells(loA, 4) = "wartet"
           ElseIf loErl > loAbg Then
               Cells(loA, 4) = "erledigt" 'Mehrheit "erledigt", Minderheit "abgebrochen" => erledigt
           ElseIf loWart < loAnz / 2 Then 'Minderheit "wartet" >= läuft
               Cells(loA, 4) = "läuft"
           End If
       End If
   Next
       
  'nach Edgar ------------------------
  Rows(loLetzte + 1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
  Range("A" & loLetzte & ":G" & loLetzte).Copy Range("A" & loLetzte + 1 & ":G" & loLetzte + 1)
     If Range("G" & loLetzte) = "A" Then
        Range("G" & loLetzte + 1) = "P"                        'neues Projekt in letzter Zeile
        Range("B" & loLetzte + 1).ClearContents                'löschen der alten Projektnummer für neues Projekt
'         Range("C" & loLetzte + 2) = Range("C" & loLetzte)      'Umgehen des "grünes Dreieck"-Fehlers
     End If
   Range("D" & loLetzte + 1).Clear
   Range("B" & loLetzte + 1).Select
   
  Application.EnableEvents = True
End Sub
Gruß

Edgar

Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
[-] Folgende(r) 1 Nutzer sagt Danke an BoskoBiati für diesen Beitrag:
  • Rabe
Suchen
Antworten Top
Rabe Offline
:-)
ThreadStarter
Registriert seit: 10.04.2014
Version(en): 2016 + 365
#22
20.10.2016, 08:32
Hi Edgar,

(19.10.2016, 14:03)BoskoBiati schrieb: ich habe mal was eingebaut in den Code für ein neues Projekt:

danke.
Wenn ich es richtig verstehe, wird überprüft, ob die Spalte D in der Zeile mit "P" leer ist und dann wird etwas eingetragen.
Wenn aber ein Mal was in der Zelle drin steht, wird es dann nicht mehr erneut aktualisiert.

Es wird überall "läuft" eingetragen, egal was in den Zellen drunter steht.

Ich habe das Makro jetzt aus der Sub "neuesProjekt" rausgenommen und als eigenes Makro auf einen Button gelegt.

.xlsb   Protokoll erweitern - V3.xlsb (Größe: 47,38 KB / Downloads: 1)
Suchen
Antworten Top
Rabe Offline
:-)
ThreadStarter
Registriert seit: 10.04.2014
Version(en): 2016 + 365
#23
25.10.2016, 10:16 (Dieser Beitrag wurde zuletzt bearbeitet: 25.10.2016, 10:17 von Rabe.)
Hallo,

hier nochmal als Wiedervorlage:

Ich habe bei der Datei und dem Makro "Status aktualisieren" noch zwei Probleme
  1. wenn in Spalte D in der Zeile mit "P" etwas eingetragen ist, daß dann dieser Inhalt nicht mehr erneut aktualisiert wird.
  2. Es wird überall "läuft" eingetragen, egal was in den Zellen drunter steht.

Hier die Vorgaben für die Spalte D in der "P"-Zeile:
  1. alle "läuft" => "läuft"
  2. alle "erledigt" => "erledigt"
  3. alle "abgebrochen" => "abgebrochen"
  4. alle "wartet" => "wartet"
  5. Mehrheit "erledigt", "abgebrochen" oder "wartet", Minderheit "läuft" => läuft
  6. Mehrheit "erledigt", "abgebrochen", Minderheit "wartet" => läuft
  7. Mehrheit "erledigt", Minderheit "abgebrochen" => "erledigt"
  8. fehlt noch was?

Dann ist etwas neues aufgetaucht:
Wenn in Spalte D gefiltert wird, kommt bei Einfügen einer Zeile eine Fehlermeldung (jetzt gerade beim Nachtesten kam der Fehler plötzlich nicht mehr), in folgender Code-Zeile:
Code:
  Range("A" & loZeile & ":G" & loZeile).Copy Range("A" & loZeile + 1 & ":G" & loZeile + 1)

Hier die Makros:
Option Explicit



Sub ZeileEinfügen()

  ' 

  ' 18.10.2016 - RaB 

  ' 

  Dim loZeile As Long

  ' 

  Application.ScreenUpdating = False

  loZeile = ActiveCell.Row

  

  'nach Edgar ------------------------ 

  Rows(loZeile + 1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

  Range("A" & loZeile & ":G" & loZeile).Copy Range("A" & loZeile + 1 & ":G" & loZeile + 1)

  Range("G" & loZeile + 1) = "A"

  Range("D" & loZeile + 1).ClearContents

  'Range("C" & loZeile + 2) = Range("C" & loZeile)              'Umgehen des "grünes Dreieck"-Fehlers 

  '----------------------------------- 

  

  Range("H" & loZeile + 1).Select

  Application.CutCopyMode = False

  Application.ScreenUpdating = True

  

End Sub



Sub fünfZeilenEinfügen()

  ' 

  ' 18.10.2016 - RaB 

  ' 

  Dim loZeile As Long

  ' 

  loZeile = ActiveCell.Row

  

  Rows(loZeile + 1).Resize(5).EntireRow.Insert

  Range("A" & loZeile & ":G" & loZeile).Copy Range("A" & loZeile + 1 & ":G" & loZeile + 5)

  Range("G" & loZeile + 1 & ":G" & loZeile + 5) = "A"

  Range("D" & loZeile + 1 & ":D" & loZeile + 5).ClearContents

  Range("H" & loZeile + 1).Select

  

End Sub



Sub neuesProjekt()

  ' 

  ' neuesProjekt anlegen 

  ' 

  Dim loLetzte As Long

  ' 

  'loZeile = ActiveCell.Row 

  loLetzte = Sheets("Protokoll").Cells(Rows.Count, 4).End(xlUp).Row                     ' letzte belegte in Spalte D (4) 

  

  'nach Edgar ------------------------ 

  Rows(loLetzte + 1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

  Range("A" & loLetzte & ":G" & loLetzte).Copy Range("A" & loLetzte + 1 & ":G" & loLetzte + 1)

  If Range("G" & loLetzte) = "A" Then

     Range("G" & loLetzte + 1) = "P"                          'neues Projekt in letzter Zeile 

     Range("B" & loLetzte + 1).ClearContents                  'löschen der alten Projektnummer für neues Projekt 

     'Range("C" & loLetzte + 2) = Range("C" & loLetzte)        'Umgehen des "grünes Dreieck"-Fehlers 

  End If

  Range("D" & loLetzte + 1).ClearContents                     'löschen des Status für neues Projekt 

  Range("B" & loLetzte + 1).Select

  

End Sub



Sub Status_aktualisieren()

  ' 

  ' Status pro Projekt aktualisieren 

  ' 

  Dim loLetzte As Long

  Dim loA As Long

  Dim loB As Long

  Dim loErledigt As Long

  Dim loLaeuft As Long

  Dim loAbgebrochen As Long

  Dim loWartet As Long

  Dim loAnzahl As Long

  Dim rng As Range

  ' 

  Application.EnableEvents = False

  Application.ScreenUpdating = False

  loLetzte = Sheets("Protokoll").Cells(Rows.Count, 4).End(xlUp).Row                      ' letzte belegte in Spalte D (4) 



  For loA = 1 To loLetzte

     If (Cells(loA, 7) = "P") Then

        Cells(loA, 4) = ""                     'leeren der Projekt-Statuszelle 

     End If

        

     If (Cells(loA, 7) = "P") And (Cells(loA, 4) = "") Then

        If Not Range("G1:G" & loLetzte).Find("P", Cells(loA, 7)) Is Nothing Then

           loB = Range("G1:G" & loLetzte).Find("P", Cells(loA, 7)).Row

           If loB < loA Then loB = loLetzte + 1

        End If

        Debug.Print loA, loB

        loAnzahl = loB - loA

        Set rng = Range(Cells(loA + 1, 7), Cells(loB - 1, 7))

        

        loLaeuft = Application.WorksheetFunction.CountIf(rng, "läuft")

        loErledigt = Application.WorksheetFunction.CountIf(rng, "erledigt")

        loAbgebrochen = Application.WorksheetFunction.CountIf(rng, "abgebrochen")

        loWartet = Application.WorksheetFunction.CountIf(rng, "wartet")

        If loLaeuft = loAnzahl Then            'alle "läuft" => "läuft" 

           Cells(loA, 4) = "läuft"

        ElseIf loErledigt = loAnzahl Then      'alle "erledigt" => "erledigt" 

           Cells(loA, 4) = "erledigt"

        ElseIf loAbgebrochen = loAnzahl Then   'alle "abgebrochen" => "abgebrochen" 

           Cells(loA, 4) = "abgebrochen"

        ElseIf loWartet = loAnzahl Then        'alle "wartet" => "wartet" 

           Cells(loA, 4) = "wartet"

           

        ElseIf loErledigt > loAbgebrochen Then 'Mehrheit "erledigt", Minderheit "abgebrochen" => "erledigt" 

           Cells(loA, 4) = "erledigt"

        ElseIf loErledigt > loLaeuft Then      'Mehrheit "erledigt", Minderheit "läuft" => "läuft" 

           Cells(loA, 4) = "läuft"

        ElseIf loAbgebrochen > loLaeuft Then   'Mehrheit "abgebrochen", Minderheit "läuft" => "läuft" 

           Cells(loA, 4) = "läuft"

        ElseIf loWartet < loAnzahl / 2 Then    'Minderheit "wartet" => "läuft" 

           Cells(loA, 4) = "läuft"

        ElseIf loLaeuft > 0 Then               'Mindestens 1x "läuft" => "läuft" 

           Cells(loA, 4) = "läuft"

        End If

     End If

  Next

  Application.ScreenUpdating = True

  Application.EnableEvents = True

End Sub

.xlsb   Protokoll erweitern - V3.1.xlsb (Größe: 47,47 KB / Downloads: 1)
Suchen
Antworten Top
schauan Offline
Einer von hier
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
#24
28.10.2016, 12:32
Hallo Ralf,

Du hast in Deinem Code ein Leeren des Eintrages in D:

Code:
If (Cells(loA, 7) = "P") Then
         Cells(loA, 4) = ""                     'leeren der Projekt-Statuszelle
      End If

Wenn das generell nicht erwünscht ist, dann müssen die 3 Zeilen weg.

Dann ist eine Bereichszuweisung wohl auch falsch.
Code:
Set rng = Range(Cells(loA + 1, 7), Cells(loB - 1, 7))

Du verweist hier auf Spalte G (=7). Später prüfst Du in diesem Bereich, ob da z.B. läuft steht.
Code:
loLaeuft = Application.WorksheetFunction.CountIf(rng, "läuft")
Steht dort nie, Du müsstest D prüfen Sad

Die Zelleinträge für den Projektstatus setzt Du, wenn die Anzahl eines Status mit der Anzahl der Zellen eines Bereichs übereinstimmt, z.B..
Code:
loWartet = loAnzahl
Wenn Dein Bereich z.B. 3 Zellen enthält und eine davon der Projektstatus ist, wo ja noch nichts drin steht, müsstest Du die Anzahl um eins reduzieren. Also z.B. weiter oben
Code:
loAnzahl = loB - loA - 1
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Homepage Suchen
Antworten Top
Rabe Offline
:-)
ThreadStarter
Registriert seit: 10.04.2014
Version(en): 2016 + 365
#25
31.01.2017, 10:14 (Dieser Beitrag wurde zuletzt bearbeitet: 31.01.2017, 10:27 von Rabe.)
Hallo André,

danke für die Verbesserung!

Button Status aktualisieren:
Nun funktioniert es bis auf einen Teil des Punktes 5 aus meinem Beitrag von oben, dort wird im Falle Mehrheit "erledigt", Minderheit "läuft" oder "wartet" der Status auf "erledigt" gesetzt und nicht auf "läuft". Siehe Block VE0147.

Bitte in diesem Block mal alle drei Sachen durchprobieren: 1x "läuft", 1x "wartet", 1x "abgebrochen" bei jeweils 3x "erledigt"
irgendwie stimmt die Reihenfolge (und die Bedingungen) des zweiten ELSEIF-Blocks nicht.

Hier mal der Code:
Sub Status_aktualisieren()

  ' 

  ' Status pro Projekt aktualisieren 

  ' 

  Dim loLetzte As Long

  Dim loA As Long

  Dim loB As Long

  Dim loErledigt As Long

  Dim loLaeuft As Long

  Dim loAbgebrochen As Long

  Dim loWartet As Long

  Dim loAnzahl As Long

  Dim rng As Range

  ' 

  Application.EnableEvents = False

  Application.ScreenUpdating = False

  loLetzte = Sheets("Protokoll").Cells(Rows.Count, 4).End(xlUp).Row    ' letzte belegte in Spalte D (4) 



  For loA = 1 To loLetzte

     '################ evtl. entfernen 

     If (Cells(loA, 7) = "P") Then

        Cells(loA, 4) = ""                     'leeren der Projekt-Statuszelle 

     End If

     '################ 

     If (Cells(loA, 7) = "P") And (Cells(loA, 4) = "") Then

        If Not Range("G1:G" & loLetzte).Find("P", Cells(loA, 7)) Is Nothing Then

           loB = Range("G1:G" & loLetzte).Find("P", Cells(loA, 7)).Row

           If loB < loA Then loB = loLetzte + 1

        End If

        Debug.Print loA, loB

        loAnzahl = loB - loA - 1

        Set rng = Range(Cells(loA + 1, 4), Cells(loB - 1, 4))

        

        loLaeuft = Application.WorksheetFunction.CountIf(rng, "läuft")

        loErledigt = Application.WorksheetFunction.CountIf(rng, "erledigt")

        loAbgebrochen = Application.WorksheetFunction.CountIf(rng, "abgebrochen")

        loWartet = Application.WorksheetFunction.CountIf(rng, "wartet")

        If loLaeuft = loAnzahl Then            'alle "läuft" => "läuft" 

           Cells(loA, 4) = "läuft"

        ElseIf loErledigt = loAnzahl Then      'alle "erledigt" => "erledigt" 

           Cells(loA, 4) = "erledigt"

        ElseIf loAbgebrochen = loAnzahl Then   'alle "abgebrochen" => "abgebrochen" 

           Cells(loA, 4) = "abgebrochen"

        ElseIf loWartet = loAnzahl Then        'alle "wartet" => "wartet" 

           Cells(loA, 4) = "wartet"

           

        ElseIf loErledigt > loAbgebrochen Then 'Mehrheit "erledigt", Minderheit "abgebrochen" => "erledigt" 

           Cells(loA, 4) = "erledigt"

        ElseIf loErledigt > loLaeuft Then      'Mehrheit "erledigt", Minderheit "läuft" => "läuft" 

           Cells(loA, 4) = "läuft"

        ElseIf loAbgebrochen > loLaeuft Then   'Mehrheit "abgebrochen", Minderheit "läuft" => "läuft" 

           Cells(loA, 4) = "läuft"

        ElseIf loWartet < loAnzahl / 2 Then    'Minderheit "wartet" => "läuft" 

           Cells(loA, 4) = "läuft"

        ElseIf loLaeuft > 0 Then               'Mindestens 1x "läuft" => "läuft" 

           Cells(loA, 4) = "läuft"

        End If

     End If

  Next

  Application.ScreenUpdating = True

  Application.EnableEvents = True

End Sub

und hier die Datei:

.xlsb   Protokoll erweitern - V3.2.xlsb (Größe: 57,79 KB / Downloads: 0)
Suchen
Antworten Top
Rabe Offline
:-)
ThreadStarter
Registriert seit: 10.04.2014
Version(en): 2016 + 365
#26
31.01.2017, 11:06 (Dieser Beitrag wurde zuletzt bearbeitet: 31.01.2017, 11:06 von Rabe.)
Hi,

ich habe es!

(31.01.2017, 10:14)Rabe schrieb: Button Status aktualisieren:
Nun funktioniert es bis auf einen Teil des Punktes 5 aus meinem Beitrag von oben, dort wird im Falle Mehrheit "erledigt", Minderheit "läuft" oder "wartet" der Status auf "erledigt" gesetzt und nicht auf "läuft". Siehe Block VE0147.

Bitte in diesem Block mal alle drei Sachen durchprobieren: 1x "läuft", 1x "wartet", 1x "abgebrochen" bei jeweils 3x "erledigt"

hier der 2. ELSEIF-Teil, falls es jemand mal durchspielen möchte:
         ElseIf loLaeuft > 0 Then               'Mindestens 1x "läuft" => "läuft" 

           Cells(loA, 4) = "läuft"

        ElseIf loWartet > 0 Then               'Mindestens 1x "wartet" => "läuft" 

           Cells(loA, 4) = "läuft"

'         ElseIf loWartet < loAnzahl / 2 Then    'Minderheit "wartet" => "läuft" 

'            Cells(loA, 4) = "läuft" 

        ElseIf loErledigt > loAbgebrochen Then 'Mehrheit "erledigt", Minderheit "abgebrochen" => "erledigt" 

           Cells(loA, 4) = "erledigt"

'         ElseIf loErledigt > loLaeuft Then      'Mehrheit "erledigt", Minderheit "läuft" => "läuft" 

'            Cells(loA, 4) = "läuft" 

'         ElseIf loAbgebrochen > loLaeuft Then   'Mehrheit "abgebrochen", Minderheit "läuft" => "läuft" 

'            Cells(loA, 4) = "läuft" 

        End If
Suchen
Antworten Top
Thema geschlossen 


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste