Thema Datum  Von Nutzer Rating
Antwort
19.09.2018 09:28:26 Thomas
NotSolved
19.09.2018 10:33:19 Thomas
NotSolved
19.09.2018 10:40:27 Flotter Feger
NotSolved
19.09.2018 11:35:21 Thomas
NotSolved
19.09.2018 13:37:50 Flotter Feger
NotSolved
19.09.2018 13:46:17 Thomas
NotSolved
19.09.2018 14:08:22 Flotter Feger
NotSolved
19.09.2018 14:19:49 Thomas
NotSolved
19.09.2018 16:59:46 Thomas
NotSolved
19.09.2018 18:01:51 Mackie
NotSolved
19.09.2018 18:50:59 Gast42663
NotSolved
19.09.2018 18:54:42 Mackie
NotSolved
Rot Merkwürdige 400 Error-Message
19.09.2018 19:00:33 Thomas
NotSolved
19.09.2018 18:59:59 Mackie
NotSolved
19.09.2018 19:01:42 Thomas
NotSolved
19.09.2018 19:03:10 Mackie
NotSolved
19.09.2018 19:13:09 Thomas
NotSolved
19.09.2018 19:30:48 Mackie
NotSolved
19.09.2018 19:39:44 Thomas
NotSolved
19.09.2018 19:40:22 Thomas
NotSolved
19.09.2018 19:54:48 Mackie
NotSolved
19.09.2018 20:09:15 Gast43707
NotSolved
19.09.2018 20:22:15 Thomas
NotSolved
19.09.2018 20:29:23 Thomas
NotSolved
19.09.2018 21:45:09 Mackie
NotSolved
19.09.2018 20:46:09 Mackie
NotSolved
19.09.2018 21:44:08 Mackie
NotSolved

Ansicht des Beitrags:
Von:
Thomas
Datum:
19.09.2018 19:00:33
Views:
752
Rating: Antwort:
  Ja
Thema:
Merkwürdige 400 Error-Message

Bei Set wsbol = Tabelle5. Diese Tabelle gibt es nicht, daher ist die Fehlermeldung "korrekt". Meine Frage ist, warum ich diese Fehlermeldung nicht erhalte, wenn das Sub gecalled wird.

 

Hier das Sub. Danke im Voraus :)

 

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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
Sub bolanalysis()
'In old + new nach Nullern filtern und spalte f+g kopieren un din bolanalysis einfügen
 
'!!!! Es muss sichergestellt werden, dass in den anderen Arbeitsblättern in BOL Analysis auch die passenden Überschriften existieren
 
 
 
Dim ws As Worksheet
Set ws = Tabelle1
Dim wsnew As Worksheet
Set wsnew = Tabelle2
Dim wsbol As Worksheet
Set wsbol = Tabelle5
 
Dim testrange As Range
 
Dim lrow As Integer
Dim Oldcell As Range
 
Dim arrCriteria() As String
Dim lngCriteriaCount As Long
Dim element As Variant
 
Dim arrCriterianew() As String
Dim lngCriterianewCount As Long
 
 
Dim lrownew As Integer
Dim NewCell As Range
 
'Löscht die alten Zeilen in Tabelle5
 
lngCriteriaCount = 3
 
ReDim arrCriteria(0 To lngCriteriaCount - 1)
arrCriteria(0) = "Royalities_old"
arrCriteria(1) = "Part#_old"
arrCriteria(2) = "Description_old"
 
lngCriterianewCount = 3
 
ReDim arrCriterianew(0 To lngCriterianewCount - 1) ' Hier wäre auch mal die fra
arrCriterianew(0) = "Royalities_new"
arrCriterianew(1) = "Part#_new"
arrCriterianew(2) = "Description_new"
 
lrow = ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row
lrownew = wsnew.UsedRange.SpecialCells(xlCellTypeLastCell).Row
lrowbol = wsbol.UsedRange.SpecialCells(xlCellTypeLastCell).Row
lcolbol = wsbol.UsedRange.SpecialCells(xlCellTypeLastCell).Column
 
 
'wsbol.Range(wsbol.Cells(4, 1), wsbol.Cells(lrowbol, lcolbol)).Delete Shift:=xlUp
 
Tabelle5.UsedRange.ClearContents
Tabelle5.UsedRange.ClearFormats
 
wsbol.Range("A1") = "Part#_old"
wsbol.Range("B1") = "Description_old"
wsbol.Range("C1") = "Royalities_old"
 
wsbol.Range("E1") = "Part#_new"
wsbol.Range("F1") = "Description_new"
wsbol.Range("G1") = "Royalities_new"
 
 
Errorhandler:
 
 
 
On Error GoTo Errorhandler1
Tabelle2.Cells.Replace What:="Part#_new", Replacement:="Part#", SearchOrder:=xlByColumns, MatchCase:=True
Tabelle2.Cells.Replace What:="Description_new", Replacement:="Description", SearchOrder:=xlByColumns, MatchCase:=True
Tabelle2.Cells.Replace What:="Royalities_new", Replacement:="Royalities", SearchOrder:=xlByColumns, MatchCase:=True
 
Tabelle1.Cells.Replace What:="Part#_old", Replacement:="Part#", SearchOrder:=xlByColumns, MatchCase:=True
Tabelle1.Cells.Replace What:="Description_old", Replacement:="Description", SearchOrder:=xlByColumns, MatchCase:=True
Tabelle1.Cells.Replace What:="Royalities_old", Replacement:="Royalities", SearchOrder:=xlByColumns, MatchCase:=True
 
Errorhandler1:
 
Tabelle1.Cells.Replace What:="Part#", Replacement:="Part#_old", SearchOrder:=xlByColumns, MatchCase:=True, LookAt:=xlWhole
Tabelle1.Cells.Replace What:="Description", Replacement:="Description_old", SearchOrder:=xlByColumns, MatchCase:=True, LookAt:=xlWhole
Tabelle1.Cells.Replace What:="Royalities", Replacement:="Royalities_old", SearchOrder:=xlByColumns, MatchCase:=True, LookAt:=xlWhole
 
Tabelle2.Cells.Replace What:="Part#", Replacement:="Part#_new", SearchOrder:=xlByColumns, MatchCase:=True, LookAt:=xlWhole
Tabelle2.Cells.Replace What:="Description", Replacement:="Description_new", SearchOrder:=xlByColumns, MatchCase:=True, LookAt:=xlWhole
Tabelle2.Cells.Replace What:="Royalities", Replacement:="Royalities_new", SearchOrder:=xlByColumns, MatchCase:=True, LookAt:=xlWhole
 
If ws.AutoFilterMode = False Then
ws.Rows(2).AutoFilter
End If
 
If wsnew.AutoFilterMode = False Then
wsnew.Rows(2).AutoFilter
End If
 
'Da steht quasi: Wenn der wert in zeile 2 (in Abhängigkeit von i) = eines der Elemente von oben
' dann --> wenn das element auch gleich einem wert in wsbol is in zeile 3 (in abhängigkeit von j)
' dann
 
For i = 1 To 30
    If ws.Cells(2, i).Value = "Royalities_old" Then
    ws.Range(ws.Cells(2, i), ws.Cells(lrow, i)).AutoFilter Field:=i, Criteria1:="<>0"
    End If
Next
 
For i = 1 To 30
    For j = 1 To 10
        For Each element In arrCriteria()
            If element = ws.Cells(2, i).Value Then  'Royalties wurden falsch geschrieben
                If element = wsbol.Cells(1, j).Value Then
                    Set testrange = ws.Range(ws.Cells(3, i), ws.Cells(lrow, i))
                   testrange.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeVisible).Copy wsbol.Cells(lrowbol + 1, j) 'Pasten noch machen wsbol.einsunterroyalties (Range("G4") G = j 4 lastrow mit offset von j
                     
                End If
            End If
        Next
    Next
Next
 
 
 
For i = 1 To 30
    If wsnew.Cells(2, i).Value = "Royalities_new" Then
    wsnew.Range(wsnew.Cells(2, i), wsnew.Cells(lrownew, i)).AutoFilter Field:=i, Criteria1:="<>0"
    End If
Next
 
For i = 1 To 30
    For j = 1 To 10
        For Each element In arrCriterianew()
            If element = wsnew.Cells(2, i).Value Then  'Royalties wurden falsch geschrieben
                If element = wsbol.Cells(1, j).Value Then
                    wsnew.Range(wsnew.Cells(3, i), wsnew.Cells(lrownew, i)).SpecialCells(xlCellTypeVisible).Copy wsbol.Cells(lrowbol + 1, j) 'Pasten noch machen wsbol.einsunterroyalties (Range("G4") G = j 4 lastrow mit offset von j
                     
                End If
            End If
        Next
    Next
Next
 
 
wsbol.Range("I1").FormulaLocal = "=SUMME(H3:H20)"
 
End Sub

 


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
19.09.2018 09:28:26 Thomas
NotSolved
19.09.2018 10:33:19 Thomas
NotSolved
19.09.2018 10:40:27 Flotter Feger
NotSolved
19.09.2018 11:35:21 Thomas
NotSolved
19.09.2018 13:37:50 Flotter Feger
NotSolved
19.09.2018 13:46:17 Thomas
NotSolved
19.09.2018 14:08:22 Flotter Feger
NotSolved
19.09.2018 14:19:49 Thomas
NotSolved
19.09.2018 16:59:46 Thomas
NotSolved
19.09.2018 18:01:51 Mackie
NotSolved
19.09.2018 18:50:59 Gast42663
NotSolved
19.09.2018 18:54:42 Mackie
NotSolved
Rot Merkwürdige 400 Error-Message
19.09.2018 19:00:33 Thomas
NotSolved
19.09.2018 18:59:59 Mackie
NotSolved
19.09.2018 19:01:42 Thomas
NotSolved
19.09.2018 19:03:10 Mackie
NotSolved
19.09.2018 19:13:09 Thomas
NotSolved
19.09.2018 19:30:48 Mackie
NotSolved
19.09.2018 19:39:44 Thomas
NotSolved
19.09.2018 19:40:22 Thomas
NotSolved
19.09.2018 19:54:48 Mackie
NotSolved
19.09.2018 20:09:15 Gast43707
NotSolved
19.09.2018 20:22:15 Thomas
NotSolved
19.09.2018 20:29:23 Thomas
NotSolved
19.09.2018 21:45:09 Mackie
NotSolved
19.09.2018 20:46:09 Mackie
NotSolved
19.09.2018 21:44:08 Mackie
NotSolved