VBA - Excel 2003 - Bereich aus Datenbank kopieren und einfügen ?

[Angelina]

Hallo Angelina,

wenn Du mit den gleichen Daten arbeitest, wie in der von Dir zuletzt eingestellten Datei, dann existiert die 54 so lange nicht, bis Du das Gegenteil beweist.

hallo atilla,

"schande über mein blondes haupt" :33:
stimmt - sorry - war mein Fehler


Aber nun mal eine ganz andere Frage.

Wie binde ich das neue Modul "Takter" - so nenne ich es mal - am besten bei mir ein?

Auf dem Tabellenblatt "Forecast" ist ein CommandButton1
Derzeit ist die Struktur/Ablauf so:

PHP-Code:

Option Explicit

Private Sub CommandButton1_Click()


Call Modul1
Call Modul2
Call Modul3
Call Modul4
Call Modul5
Call Modul6
Call Modul7
Call Modul8

Application.CutCopyMode = False

Worksheets("Forecast").Range("DE1").Copy
Worksheets("Forecast").Range("BT47").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Worksheets("Forecast").Range("DE1").Copy
Worksheets("Forecast").Range("BT48").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Worksheets("Forecast").Range("DE1").Copy
Worksheets("Forecast").Range("BT49").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Worksheets("Forecast").Range("DE1").Copy
Worksheets("Forecast").Range("BT52").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Worksheets("Forecast").Range("DE1").Copy
Worksheets("Forecast").Range("BT53").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Worksheets("Forecast").Range("DE1").Copy
Worksheets("Forecast").Range("BT54").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Range("DA1").Select

Application.CutCopyMode = True


'Schreibe in die Datenbanken
With Sheets("DatenbankA")
  .Cells(IIf(.Range("A1") = vbNullString, 1, .Cells(Rows.Count, 1).End(xlUp).Offset(1).Row), 1).Resize(3, 13) = Range("BT47:CF49").Value
End With

 With Sheets("DatenbankB")
  .Cells(IIf(.Range("A1") = vbNullString, 1, .Cells(Rows.Count, 1).End(xlUp).Offset(1).Row), 1).Resize(3, 13) = Range("BT52:CF54").Value
End With


End Sub 


Wenn ich nun z.B. in K diese Einträge mache
1000
900

Dann soll die 1000 in A:J angezeigt werden und dann mein o.g. Ablauf
Call Modul1
Call Modul2
Call Modul3
Call Modul4
Call Modul5
Call Modul6
Call Modul7
Call Modul8
usw. bis inkl. das Schreiben in die Datenbanken

und dann soll der zweite Eintrag in der Spalte K
die 900
abgearbeitet werden. Gleicher Ablauf wie beim Eintrag 1000.

Hat Spalte K dann keinen Eintrag mehr ist alles beendet.

Was würdest du mir empfehlen?


Nochmals viele viele liebe Grüße

Angelina

[atilla]

Hallo Angelina,

ich denke so sollte es gehen:

Beachte bitte, dass ich unten stehenden Code verändert habe.
Nimm bitte diesen. Der bisherige funktioniert nur dann richtig, wenn er hinter der Tabelle steht.

Code:

Option Explicit

Sub Liste()
   Dim lngLetzte As Long
   Dim lngAnzahl As Long, lngAnzahl2 As Long
   Dim i As Long, j As Long, n As Long
   Dim Takt As Long
   Dim R
   Dim arrDaten1, arrDaten2
   Dim arr()
  
   Takt = Sheets("Start").Range("L1")
  
   'Prüfen ob in Splate K Werte
   If Takt < 1 Then
      MsgBox "Takt leer oder < 1 "
      Exit Sub
   End If
  
   lngAnzahl = Application.WorksheetFunction.Count(Sheets("Start").Columns(11))
   lngAnzahl2 = Application.WorksheetFunction.CountA(Sheets("Start").Columns(11))
   'Prüfen ob in Spalte Text vorhanden
   If lngAnzahl <> lngAnzahl2 Then
      MsgBox "Kein Text zulässig!"
      Exit Sub
   End If
  
   'Prüfen ob Werte innerhalb von Takt
   If Application.WorksheetFunction.Min(Sheets("Start").Range("K1:K" & lngAnzahl).Value) - Takt + 1 < 1 Then
      MsgBox "Geht nicht!!!" & vbLf & vbLf & "Der Wert " & Application.WorksheetFunction.Min(Sheets("Start").Range("K1:K" & lngAnzahl)) _
      & " ist kleiner als " & Takt & " !"
      Exit Sub
   End If
  
   With Sheets("Daten")
      lngLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
      ReDim arr(lngLetzte - 1, 9)
      arrDaten1 = Sheets("Daten").Range("A1:A" & lngLetzte).Value 'Spalte A der Datenbank einlesen
      'prüfen ob die Werte überhaupt in der Datenbank vorkommen
      For i = 1 To lngAnzahl
         R = Application.Match(Sheets("Start").Cells(i, 11), arrDaten1, 0)
         If Not IsNumeric(R) Then
            MsgBox "Der Wert " & Sheets("Start").Cells(i, 11) & "  existiert in der Datenbank nicht!"
            Exit Sub
         End If
      Next i

      Sheets("Start").Columns("A:J").ClearContents  'Ausgabe Spalten leeren
      arrDaten2 = Sheets("Daten").Range("A1:H" & lngLetzte).Value    'Spalte A:H der Datenbank einlesen
       For i = 1 To lngAnzahl                                  'von der ersten bis zur letzten Zahl in K
         R = Application.Match(Sheets("Start").Cells(i, 11), arrDaten1, 0)
         For j = 1 To Takt
            arr(j - 1, 0) = arrDaten2(R, 1)  'Spalte A einlesen
            For n = 2 To 8
               arr(j - 1, n) = arrDaten2(R, n)  'Spalten B bis H einlesen
            Next n
            R = R - 1
         Next j
         'Nach jeder Zahl in Spalte K wird hier in Tabelle Start geschrieben
         Sheets("Start").Range("L2") = "'" & i & " / " & lngAnzahl 'Ausgabe Anzahl der Durchläufe
         Sheets("Start").Range("A1:I1").Offset(0, 0).Resize(Takt) = arr  'Ausgabe der eingelesenen Daten für diesen Durchlauf
         'hier können Deine andern Aufrufe stehn
         Call Modul1
         Call Modul2
         Call Modul3
         Call Modul4
         Call Modul5
         Call Modul6
         Call Modul7
         Call Modul8
      Next i             'nächste Zahl in Spalte K
   End With

End Sub

Den Code nicht hinter die Tabelle sondern in ein allgemeines Modul einfügen.
Für den Code ist es unerheblich, ob Tabelle Start aktiviert ist oder nicht.

Wenn die aufzurufende Prozedur sich in Modul1 befindet und diese zum Beispiel "Sub mach_etwas()" heißt,
dann rufst Du natürlich nicht mit:

Call Modul1

auf, sonder mit:

Call mach_etwas()

Aber das weißt Du sicherlich.

[Angelina]

hallo lieber atilla,

nochmals herzlichen dank - wirklich danke von Herzen

Ich werde dann morgen mal alles einbauen und dir dann berichten.

Habe jetzt noch ca. eine Stunde - dann muß ich auf die Arbeit / Krankenhaus
arbeite dort auf der Intensivstation :76:

:65:

bis morgen :50:

Danke danke danke nochmals :28:28:

LG
Angelina

[atilla]

Hallo Angelina,

hoffe, dass Du keine zu anstrengende Nacht hattest. Ich habe großen Respekt vor Deiner Arbeit. :23:

Zwischenzeitlich habe ich in Deiner letzten Datei etwas rumgeschraubt und habe ein Schmankerl für Dich.

In der Datei habe ich nur zu Demo 3 zusätzliche Makros eingebaut, die sinnfrei eine Schleife durchlaufen und stellvertretend für Deine anderen Makros stehen. Sie befinden sich alle im Modul2. In Modul1 befindet sich der Code zum Takten.

Teste einfach mal. Wenn Dir das zusagt, und Du Deine Makros in den Code takten einbauen möchtest,
dann achte auf folgendes:
In takten befindet sich der errorhandler. Wenn Du in den anderen Codes auch einen hast, dann lösch diese dort. In takten wird auch die automatische Berechnung sowie die Bildschirmaktualisierung abgeschaltet und wieder eingeschaltet. Deshalb sollte das in andern Codes auch nicht auftreten.

Also in den andern Codes alle Zeilen die so heißen wie eine der folgenden Zeilen :

Code:

Application.Calculation = xlCalculationManual 'automatische Berechnung abschalten
   Application.ScreenUpdating = False            'Bildschirmaktualisierung abschalten
   Application.Calculation = xlCalculationAutomatic 'automatische Berechnung wieder ein
   Application.ScreenUpdating = True            'Bildschirmaktualisierung ein

bitte löschen.

Wenn du in den anderen Code so etwas stehen hast: On Error GoTo, muss man genau hinschauen, wo die Sprungmarke hinführt.

Dann teste mal:

  Takten4.xls (Größe: 261,5 KB / Downloads: 2)

[Angelina]

hallo atilla,

Ich habe großen Respekt vor Deiner Arbeit.

Danke ... Frau kämpft - zwischen Beatmungsgerät und Defibrillator - mit den Ärzten ums Überleben der Patienten ... anstrengende Angehörige ... gibt ein schönes Buch darüber ... Hinter den Türen der Intensivstation

Ich habe nun - Version von gestern - alles verbaut (meine Module) - getestet und läuft fehlerfrei.

Zwischenzeitlich habe ich in Deiner letzten Datei etwas rumgeschraubt und habe ein Schmankerl für Dich.

Ups ... nochmals soviel gemacht für mich

Ich werde das dann heute oder morgen mal versuchen umzubauen.

Beim meiner aktuellen Version ist mir schon aufgefallen das es lange dauert und das Display hin und her springt. Vielleicht bekomme ich ja das mit deiner neuen Version verbessert. Mir war heute nur wichtig, das erstmal alles läuft und das Ergebnis stimmt.

Nochmals danke danke danke für deine tolle Arbeit - ich gebe dann morgen nochmals Bescheid
bzgl. der aktuellen Version.

Ich bin dir über alles dankbar :18:

Drücke dich

LG
Angelina

[Angelina]

hallo atilla,

einige Probleme/Fragen bezüglich Version 4


Soweit habe ich alles umgebaut - diese Fragen habe ich dazu:

1.
Deine UserForm1 habe ich exportiert
und dann in meine importiert
War das richtig? oder?

2.
Du hast in der UserForm1 u.a. diesen VBCode

PHP-Code:

Sub Fortschritt2()
Dim X As String
Dim SBar As String
X = "X"

SBar = SBar & X
Application.StatusBar = "Teilschritt 1 " & SBar
MsgBox "weiter"

SBar = SBar & X
Application.StatusBar = "Teilschritt 2 " & SBar
MsgBox "weiter"

SBar = SBar & X
Application.StatusBar = "Teilschritt 3 " & SBar
MsgBox "weiter"

SBar = SBar & X
Application.StatusBar = "Teilschritt 4 " & SBar
MsgBox "weiter"

Application.StatusBar = False

End Sub 


Erweitere ich diese Teilschritte von 4 auf die Anzahl meiner Module?

Habe mal getestet und bekomme diese Meldung
Benutzerdefinierter Typ nicht definiert
Private Sub StatusBar1_PanelClick(ByVal Panel As MSComctlLib.Panel)

Echt Hammer deine neue Version - das mit der Progressbar wollte ich unbedingt einbauen
gefällt mir soooooooooooooo gut :28:28:


LG
Angelina

[atilla]

Hallo Angelina,

du kannst alles Code hinter der Userform löschen.
Da habe ich ein wenig rumgemacht, :29: ...also verschiedenes getestet.

Mit dem exportieren und importieren, alles OK.
Du kannst aber, wenn beide Dateien in der gleichen Excel Instanz geöffnet sind, die Userform anklicken und festhalten und einfach in Dein Projekt ziehen.

Hier an diesen Stellen kannst Du Deine Module einbauen:

Code:

End With
         'hier können Deine andern Aufrufe stehn
         Call test1
         UserForm1.Label4.Caption = "Makro test 1 abgearbeitet!"
         DoEvents
         Call test2
         UserForm1.Label4.Caption = "Makro test 2 abgearbeitet!"
         DoEvents
         Call test3
         UserForm1.Label4.Caption = "Makro test 3 abgearbeitet!"
         DoEvents
'         Call Modul5
'         Call Modul6
'         Call Modul7
'         Call Modul8
      Next i

Lies bitte auch die Kommentare im Code. test1 bis test3 stehen praktisch für drei Deiner Module.

das mit der Progressbar wollte ich unbedingt einbauen

Das hatte ich schon gerochen als Du das mit Zelle L2 beschrieben hast. :21:
Männer verstehen Frauen zwar nicht aber wir können sie lesen. :19:

[Angelina]

hallo atilla,

so konnte die Progressbar erfolgreich einbauen - und zum laufen bringen.

Vorher lief das Programm klack ... klack ... pro Wert in Spalte K
Nun läuft es ... zack zack


a b e r ...

Die Werte stimmen nicht mehr die letztendlich in die DatenbankA und DatenbankB geschrieben werden.

Ich denke es liegt an den von mir entfernten False/True in den entsprechenden 8 Module
Ich hatte nur in einem Modul On Error GoTo der ging an das Ende der Sub.

Ich baue nun Modul für Modul die False/True wieder ein und teste dann mal.
Wenn alles wieder richtig ist, dann kann ich ja Modul für Modul schauen - welches False/True
benötigt wird - denke ich.

Also melde ich mich bis morgen nochmals hier ...


Danke für alles

LG
Angelina

[Angelina]

Hallo atilla,


habe heute doch noch am Programm gearbeitet - leider nicht ganz so erfolgreich.

Es läuft nun die Version Takten4 - aber nur mit Änderungen

so habe ich es nun:

PHP-Code:

Modul1
######################################
    Application.ScreenUpdating = False
.
.
.

    Application.ScreenUpdating = True




Modul2
######################################
    Application.ScreenUpdating = False
.
.
.

    Application.ScreenUpdating = True



Modul3
######################################
hat kein False/True

Modul4
######################################
hat kein False/True


Modul5
######################################
    Application.ScreenUpdating = False
.
.
.

    Application.ScreenUpdating = True



Modul6
######################################
hat kein False/True

Modul7
######################################
hat kein False/True

Modul8
######################################
dieses Modul hat mehrere Sub
1. hat ScreenUpdating = False/True

1.2 Call eine Sub 

'On Error GoTo ErrorHandler
   Application.ScreenUpdating = False
.
.
.

'ErrorHandler:
   Application.ScreenUpdating = True
  ' If Err.Number <> 0 Then MsgBox "Fehler Nr.: " & Err.Number & vbCrLf _
   ' & Err.Description, vbCritical, "Bitte prüfen ..."

1.3 call eine Sub
    Application.ScreenUpdating = False
.
.
.

    Application.ScreenUpdating = True

1.4 call eine Sub
    Application.ScreenUpdating = False
.
.
.

    Application.ScreenUpdating = True


Modul9
######################################
Application.CutCopyMode = False
.
.
.
Application.CutCopyMode = True

'Schreibe in die Datenbanken

Modul10
######################################
Takten4 


Erst wenn ich die o.g. Module mit False/True lasse
und nur in dem Modul8 den "On Error GoTo ErrorHandler" abschalte

und

beim Takten4 nur das ändere:

.
.
.

'Application.Calculation = xlCalculationManual 'automatische Berechnung abschalten
'Application.ScreenUpdating = False 'Bildschirmaktualisierung abschalten
.
.
.


ErrorHandler:

'Application.Calculation = xlCalculationAutomatic 'automatische Berechnung wieder ein
'Application.ScreenUpdating = True 'Bildschirmaktualisierung ein



läuft es - Fehlerfrei !!!

Jedoch durch die ganzen False/True sooooooooooo laaaaaaaaaaaaaangsam ....
Praktisch wie die alte Version Takten3 nur halt mit Progressbar

Mache ich alle True/False in meinen Modulen raus dann werden keine Daten in die Datenbank
eingetragen - oder wenn ich da mal da False/True rausnehme, dann werden immer die gleichen
Daten in die Datenbank geschrieben.

Das ist der aktuelle Stand - hast du noch eine Idee? Geschwindigkeit!


LG
Angelina

[atilla]

Hallo Angelina,

eine Ferndiagnose ist schwierig.

Ich vermute, dass Du irgendwo Formeln stehen hast, deren Berechnung benötigt werden, deshalb stimmen die Ergebnisse nicht, wenn die Berechnung abgeschaltet wird.

Ich würde folgendes mal testen: In allen Modulen Aplication.Screenupdatig auskommentieren und nur in takten aktivieren.

Ansonsten kannst Du mir die Datei per Mail mal zusenden.