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, 15: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, 09:32
Hi Edgar,

(19.10.2016, 15: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, 11:16 (Dieser Beitrag wurde zuletzt bearbeitet: 25.10.2016, 11: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, 13: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, 11:14 (Dieser Beitrag wurde zuletzt bearbeitet: 31.01.2017, 11: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, 12:06 (Dieser Beitrag wurde zuletzt bearbeitet: 31.01.2017, 12:06 von Rabe.)
Hi,

ich habe es!

(31.01.2017, 11: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