Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema RefEdit
BildScreenshot zu RefEdit RefEdit-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema TextBox
BildScreenshot zu TextBox TextBox-Seite mit Beispielarbeitsmappe aufrufen

Bereich in Schlaufe anpassen | Herbers Excel-Forum


Betrifft: Bereich in Schlaufe anpassen von: Sascha
Geschrieben am: 24.01.2012 09:15:01

Guten Morgen Experten,

In nachfolgendem Code werden alle Tabellenblätter auf Eingabe > 0 in den Spalten 3-16 überprüft
Wie muss ich es machen, wenn ich speziell für ein Tabellenblatt (MSW5), die Spalten 3-28 überprüfen möchte?
Bei allen anderen Blättern bleibt es von 3-16
Hier der Code:

Sub MSWfehlt()
Dim x&

MyDay = Format(Day(Date), "00")
mytext = ""
Hilfstext = ""
Total = Format(Sheets("Total").Cells(MyDay + 5, 18).Value, "###0.0")
For x = 1 To Worksheets.Count - 4 'Blendet die letzten 4 tabellen aus

 
    With Worksheets(x)
    If .Name <> ("MSW9") Then 'Blendet MSW9 aus
    
      If WorksheetFunction.CountA(.Range(.Cells(MyDay + 2, 3), .Cells(MyDay + 2, 16))) = 0 Then
         mytext = mytext & "  " & .Name
     
    
    
    End If
    End If
    
    End With
    
    Next
    
    
 
End Sub
Liebe Grüsse Sascha

  

Betrifft: AW: Bereich in Schlaufe anpassen von: Josef Ehrensberger
Geschrieben am: 24.01.2012 09:25:23


Hallo Sascha,

Sub MSWfehlt()
    Dim lngDay As Long, lngindex As Long
    Dim myText As String, HilfsText As String, Total As String
    
    lngDay = Day(Date) + 2
    
    Total = Format(Sheets("Total").Cells(lngDay + 5, 18).Value, "###0.0")
    
    For lngindex = 1 To Worksheets.Count - 4 'Blendet die letzten 4 tabellen aus
      With Worksheets(lngindex)
        Select Case .Name
          Case "MSW9"
          Case "MSW5"
            If WorksheetFunction.CountA(.Range(.Cells(lngDay, 3), _
              .Cells(lngDay, 28))) = 0 Then myText = myText & " " & .Name
          Case Else
            If WorksheetFunction.CountA(.Range(.Cells(lngDay, 3), _
              .Cells(lngDay, 16))) = 0 Then myText = myText & " " & .Name
        End Select
      End If
    End With
  Next
  
End Sub






« Gruß Sepp »



  

Betrifft: AW: Bereich in Schlaufe anpassen von: Sascha
Geschrieben am: 24.01.2012 10:09:44

Hallo Sepp,

Danke für die schnelle Antwort.
Ich bekomme jetzt den Fehler:

Case Else ausserhalb von Select Case... ?

Gruss Sascha


  

Betrifft: AW: Bereich in Schlaufe anpassen von: Bertram
Geschrieben am: 24.01.2012 10:29:48

Hallo,

auf die Schnelle würde ich sagen, dass "End if" gehört da raus.

Gruß
Bertram


  

Betrifft: AW: Bereich in Schlaufe anpassen von: Sascha
Geschrieben am: 24.01.2012 10:42:45

hallo bertram.
hab ich schon probiert.
aber der fehler bleibt bestehen

lg sascha


  

Betrifft: AW: Bereich in Schlaufe anpassen von: Sascha
Geschrieben am: 24.01.2012 11:29:36

Hallo Bertram,

Sorry, Du hattest Recht... Ich hatte eine Zeilenschaltung nach dem "Then" gemacht.

Gruss Sascha


  

Betrifft: AW: Bereich in Schlaufe anpassen von: Josef Ehrensberger
Geschrieben am: 24.01.2012 10:45:49


Hallo Sascha,

da hat sich ein "End If" eingeschlichen;-))

Sub MSWfehlt()
  Dim lngDay As Long, lngindex As Long
  Dim myText As String, HilfsText As String, Total As String
  
  lngDay = Day(Date) + 2
  
  Total = Format(Sheets("Total").Cells(lngDay + 5, 18).Value, "###0.0")
  
  For lngindex = 1 To Worksheets.Count - 4 'Blendet die letzten 4 tabellen aus
    With Worksheets(lngindex)
      Select Case .Name
        Case "MSW9"
        Case "MSW5"
          If WorksheetFunction.CountA(.Range(.Cells(lngDay, 3), _
            .Cells(lngDay, 28))) = 0 Then myText = myText & " " & .Name
        Case Else
          If WorksheetFunction.CountA(.Range(.Cells(lngDay, 3), _
            .Cells(lngDay, 16))) = 0 Then myText = myText & " " & .Name
      End Select
    End With
  Next
  
End Sub






« Gruß Sepp »



  

Betrifft: AW: Bereich in Schlaufe anpassen von: Sascha
Geschrieben am: 24.01.2012 11:28:42

Ah, ich hatte noch nach "then" eine Zeilenschaltung.... nun kommt kein Fehler mehr,
aber...

Es zeigt mir die Blattnahmen derer, die in den Bereichen noch NULL haben, nicht in der Userform an...
Kann da noch was falsch sein beim Aufruf?

Hier der Code der Userform:

Private Sub UserForm_Activate()
Application.ScreenUpdating = False
MSWfehlt
TextBox1.Text = Trim(myText)
If Len(Auswahl_MSW.TextBox1.Text) = 0 Then
TextBox1.Text = Trim(HilfsText & Total)
End If
Application.ScreenUpdating = True
End Sub
LG Sascha


  

Betrifft: AW: Bereich in Schlaufe anpassen von: Josef Ehrensberger
Geschrieben am: 24.01.2012 11:37:49


Hallo Sascha,

"myText" gilt doch nur in der Prozedur "MSWfehlt", bleibt also immer leer.

Probier es so.

Public Function MSWfehlt() As String
  Dim lngDay As Long, lngindex As Long
  Dim myText As String, HilfsText As String, Total As String
  
  lngDay = Day(Date) + 2
  
  Total = Format(Sheets("Total").Cells(lngDay + 5, 18).Value, "###0.0")
  
  For lngindex = 1 To Worksheets.Count - 4 'Blendet die letzten 4 tabellen aus
    With Worksheets(lngindex)
      Select Case .Name
        Case "MSW9"
        Case "MSW5"
          If WorksheetFunction.CountA(.Range(.Cells(lngDay, 3), _
            .Cells(lngDay, 28))) = 0 Then myText = myText & " " & .Name
        Case Else
          If WorksheetFunction.CountA(.Range(.Cells(lngDay, 3), _
            .Cells(lngDay, 16))) = 0 Then myText = myText & " " & .Name
      End Select
    End With
  Next
  If Len(myText) Then MSWfehlt = Trim$(myText)
End Function



Private Sub UserForm_Activate()
  
  TextBox1.Text = MSWfehlt
  
End Sub



Und wenn ihr euch entlich mal angewöhnen würdet die Variablen sauber zu deklarieren und mit "Option Explicit" zu arbeiten, dann würden viele fehler gar nicht auftreten, bzw. man könnte sie sofort erkennen!




« Gruß Sepp »



  

Betrifft: AW: Bereich in Schlaufe anpassen von: Sascha
Geschrieben am: 24.01.2012 14:43:28

Hallo Sepp,

Vielen Dank für Deine Antwort.
Es funktioniert soweit...

Schönen Abend und Gruss
Sascha


Beiträge aus den Excel-Beispielen zum Thema "Bereich in Schlaufe anpassen"