Thema Datum  Von Nutzer Rating
Antwort
15.08.2013 11:30:07 Jan
NotSolved
15.08.2013 11:46:45 Franz
NotSolved
Rot Excel-Spielereien
 15.08.2013 11:54:24 Korbinian
NotSolved

Ansicht des Beitrags:
Von:
Korbinian		 Datum:
15.08.2013 11:54:24		 Views:
1046		 Rating:
     
Antwort:
  Ja
Thema:
Excel-Spielereien

Ich habe so etwas ähnliches schon programmiert allerdings in einer datei

evtl hilft dir das weiter

 

 

?
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
Sub Material_auslesen()
Dim MatNr As String
Dim letztezeiletabelle1 As Integer
Dim letztezeiletabelle2 As Integer
Dim T1Zeile As Integer, T2Zeile As Integer
Dim Lagerort As String
 
letztezeiletabelle1 = Worksheets("MatListe").Cells(1048576, 1).End(xlUp).Row
letztezeiletabelle2 = Worksheets("Ausgabe").Cells(1048576, 1).End(xlUp).Row
 
'Fehlerbehandlung
On Error GoTo fehler:
 
'Jede Zeile aus MatListe
For T1Zeile = 1 To letztezeiletabelle1
 
'letzte Zeile neu ermitteln nach änderung
letztezeiletabelle1 = Worksheets("MatListe").Cells(1048576, 1).End(xlUp).Row
letztezeiletabelle2 = Worksheets("Ausgabe").Cells(1048576, 1).End(xlUp).Row
 
'Materialnummer erfassen
MatNr = ThisWorkbook.Worksheets("MatListe").Cells(T1Zeile, 1).Value
Lagerort = ThisWorkbook.Worksheets("MatListe").Cells(T1Zeile, 4).Value
 
'Material in Tabelle2 suchen
'Bei Fund dazuzählen und nächste MatNr nehmen
    'ansonsten komplette MatNr + Bezeichnung + Anzahl in Tabelle2 schreiben
ThisWorkbook.Worksheets("Ausgabe").Select
For T2Zeile = 1 To letztezeiletabelle2
    If Worksheets("Ausgabe").Cells(T2Zeile, 1).Value = MatNr And ThisWorkbook.Worksheets("Ausgabe").Cells(T2Zeile, 4).Value = Lagerort Then
        Cells(T2Zeile, 3).Value = Cells(T2Zeile, 3).Value + ThisWorkbook.Worksheets("MatListe").Range("C" & T1Zeile).Value
        GoTo nächste_MatNr
    End If
Next T2Zeile
 
'Bei keinem Fund werte komplett unten dran schreiben
Cells(letztezeiletabelle2 + 1, 1).Value = ThisWorkbook.Worksheets("MatListe").Range("A" & T1Zeile).Value
Cells(letztezeiletabelle2 + 1, 2).Value = ThisWorkbook.Worksheets("MatListe").Range("B" & T1Zeile).Value
Cells(letztezeiletabelle2 + 1, 3).Value = ThisWorkbook.Worksheets("MatListe").Range("C" & T1Zeile).Value
Cells(letztezeiletabelle2 + 1, 4).Value = ThisWorkbook.Worksheets("MatListe").Range("D" & T1Zeile).Value
Cells(letztezeiletabelle2 + 1, 5).Value = ThisWorkbook.Worksheets("MatListe").Range("E" & T1Zeile).Value
 
 
nächste_MatNr:
 
Next T1Zeile
 
 
Daten_sortieren 'Sortieren
 
ThisWorkbook.Worksheets("Ausgabe").Range("A1").Select 'Ausgabetabelle auswählen
 
MsgBox "Datei wurde erfolgreich zusammengefasst!"
 
Exit Sub
 
fehler:
MsgBox "Es ist ein Fehler aufgetreten!" & vbCrLf & _
        Err.Number & " " & Err.Description
 
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:
WYSIWYG-Editor, ctl00_Content_editor1



  • 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
15.08.2013 11:30:07 Jan
NotSolved
15.08.2013 11:46:45 Franz
NotSolved
Rot Excel-Spielereien
 15.08.2013 11:54:24 Korbinian
NotSolved