Thema Datum  Von Nutzer Rating
Antwort
25.07.2017 09:09:08 Tay
NotSolved
25.07.2017 09:57:10 Gast58112
NotSolved
25.07.2017 10:19:19 Gast46487
NotSolved
25.07.2017 10:53:43 Tay
Solved
Rot Mehrere If-Schleifen verkürzt schreiben
25.07.2017 17:16:01 Gast70117
NotSolved

Ansicht des Beitrags:
Von:
Gast70117
Datum:
25.07.2017 17:16:01
Views:
872
Rating: Antwort:
  Ja
Thema:
Mehrere If-Schleifen verkürzt schreiben
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
Option Explicit
 
Sub BEST()
Dim lngRow As Long               'jeweils letzte Zeile, wozu mehr
Dim i As Long
Dim Sh As Excel.Worksheet
Set Sh = ActiveSheet
 
Application.ScreenUpdating = False
With Sh
   lngRow = .Cells.Find("*", .Cells(1), -4123, 2, 1, 2, False).Row
   For i = lngRow To 2 Step -1
    If .Cells(i, 3) = "" Then
    .Rows(i).Delete
    End If
   Next i
   '
   lngRow = .Cells.Find("*", .Cells(1), -4123, 2, 1, 2, False).Row
   For i = lngRow To 2 Step -1
    If .Cells(i, 11) = "ERLEDIGT" Or Cells(i, 11) = "ABGESCHLOSSEN (MENGENMÄSSIG)" Or Cells(i, 11) = "ABGESCHLOSSEN (WERTMÄSSIG)" Or Cells(i, 11) = "KOMPL.GELIEFERT" Or Cells(i, 11) = "STORNIERT" Or Cells(i, 11) = "" Then
    .Rows(i).Delete
    End If
   Next i
   '
   lngRow = .Cells.Find("*", .Cells(1), -4123, 2, 1, 2, False).Row
   For i = lngRow To 2 Step -1
    If .Cells(i, 1) = "inaktiv" Then
    .Rows(i).Delete
    End If
   Next i
End With
Application.ScreenUpdating = True
End Sub
 
Sub ULTIMATE()
Dim Sh As Excel.Worksheet
Dim RngA As Range
Dim V As Variant
Dim Arr11() As String
Arr11 = Split("ERLEDIGT,ABGESCHLOSSEN (MENGENMÄSSIG),ABGESCHLOSSEN (WERTMÄSSIG),KOMPL.GELIEFERT,STORNIERT", ",")
 
Application.ScreenUpdating = False
Set Sh = ActiveSheet
 
   With Sh
      On Error Resume Next
      'If Cells(i, 3) = "" Then
      Set RngA = myRange(Sh)
      RngA.Columns(3).SpecialCells(4).EntireRow.Delete
                   
      'If Cells(i, 11) = "ERLEDIGT" Or
      Set RngA = myRange(Sh)
      For Each V In Arr11
         RngA.Columns(11).Replace V, "", 1, 1
      Next V
      RngA.Columns(11).SpecialCells(4).EntireRow.Delete
             
      'If Cells(i, 1) = "inaktiv"
      Set RngA = myRange(Sh)
      RngA.Columns(1).Replace V, "inaktiv", 1, 1
      RngA.Columns(11).SpecialCells(4).EntireRow.Delete
      On Error GoTo 0
   End With
 
Application.ScreenUpdating = True
 
End Sub
 
Private Function myRange(wsh As Worksheet) As Range
Dim lngRow As Long, lngCol As Long
With wsh
   lngRow = .Cells.Find("*", .Cells(1), -4123, 2, 1, 2, False).Row
   lngCol = .Cells.Find("*", .Cells(1), -4123, 2, 2, 2, False).Column
   Set myRange = Range(.Cells(1, 1), .Cells(lngRow, lngCol))
End With
End Function

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
25.07.2017 09:09:08 Tay
NotSolved
25.07.2017 09:57:10 Gast58112
NotSolved
25.07.2017 10:19:19 Gast46487
NotSolved
25.07.2017 10:53:43 Tay
Solved
Rot Mehrere If-Schleifen verkürzt schreiben
25.07.2017 17:16:01 Gast70117
NotSolved