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

[Angelina]

Hallo Angelina,


teste mal:

hallo

danke das du dir die Zeit genommen hast.

Ist zu 99% schon perfekt:

2 Probleme gibt es noch

1.
Den Fehler habe ich gemacht
Die Anzeige in L2 muß in Abhängigkeit der Spalte K sein

Das bedeutet:
Die Anzahl von Einträgen in Spalte K besagt wieviel Durchläufe es maximal geben kann.

Beispiel:
Spalte K hat 5 Einträge - dann ist das 1/5 ... 2/5 ... usw. bis 5/5




Das war das kleinste Problem!

2.
Das größte Problem sehe ich in der Fehlerbehandlung / MsgBox Anzeige


Ist der Eintrag in Spalte K eine Zahl, wenn Text dann sofort Hinweis MsgBox
"Kein Text zulässig!"

Sind die Einträge in der Spalte K überhaupt in der Datenbank vorhanden, wenn einer davon nicht vorhanden ist,
dann MsgBox
"Der Eintrag ... ist nicht in der Datenbank!"
Natürlich nur einmal prüfen nicht bei jedem Durchlauf

Es muß auch der größte und der kleinste Eintrag in der Spalte K ermittelt werden
Sonst arbeitet der Takt nicht richtig.

Ist z.B. der kleinste Eintrag in Spalte K 50 und ich habe in L1 51 eingegeben dann können
im Bereich A:J keine 51 Zeilen mehr angezeigt werden.

Dann ist mir noch folgendes aufgefallen - was ich mir nicht erklären kann.

Ich trage z.B. in der Spalte K das ein
K1 1000
K2 999
K3 998 und ziehe runter bis
.
.
.
der Wert in K 50 ist
L1 habe ich 50 eingegeben

dann Programm laufen lassen (derzeitige Version)
irgendwann kommt die Fehlermeldung Laufzeitfehler 1004
"Anwendungs- oder objektdefinierter Fehler"


LG
Angelina

[atilla]

Hallo Angelina,

Ist der Eintrag in Spalte K eine Zahl, wenn Text dann sofort Hinweis MsgBox
"Kein Text zulässig!"

Soll die Prüfung vor dem Starten passieren oder während des Durchlaufs?
Die gleiche Frage betrifft auch die anderen Prüfungen.

Es muß auch der größte und der kleinste Eintrag in der Spalte K ermittelt werden

Muss nach einer konkreten Zahl geprüft werden oder reicht es aus ob die Anzahl der Takt Größe entspricht?

[Angelina]

hallo atilla,

Soll die Prüfung vor dem Starten passieren oder während des Durchlaufs?
Die gleiche Frage betrifft auch die anderen Prüfungen.

Vor dem Starten reicht - denke ich jetzt - da sonst das Programm ständig prüft und langsamer
wird - ich rufe ja am Ende (pro Durchlauf) noch 8 x über call andere Module auf.

Muss nach einer konkreten Zahl geprüft werden oder reicht es aus ob die Anzahl der Takt Größe entspricht?

Die Anzahl in Spalte K besagt ja nur wieviel Durchläufe es gibt.

Ist die kleinste Zahl in der Spalte K unterhalb der Taktgröße dann können nicht mehr soviele Zeilen
in der Spalte A:J ermittelt werden - dies ist ein Fehler.

Ich denke vielleicht kommt der eine oder andere Fehler noch im Laufe der Testphase hinzu bezüglich
möglicher/denkbarer Fehlermeldungen.

Wenn dieses Modul nicht richtig läuft können die anderen 8 Module von mir auch nicht richtig laufen.

LG
Angelina

[atilla]

Hallo Angelina,

dann teste noch einmal:

Code:

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, arrZahlen
   Dim arr()
  
   Takt = Range("L1")
  
   'Prüfen ob in Spalte Text vorhanden
   lngAnzahl = Application.WorksheetFunction.Count(Columns(11))
   lngAnzahl2 = Application.WorksheetFunction.CountA(Columns(11))
   If lngAnzahl <> lngAnzahl2 Then
      MsgBox "Kein Text zulässig!"
      Exit Sub
   End If
  
   'Prüfen ob Werte innerhalb von Takt
   arrZahlen = Range("K1:K" & lngAnzahl).Value
   If Application.WorksheetFunction.Min(arrZahlen) - Takt + 1 < 1 Then
      MsgBox "Geht nicht!!!" & vbLf & vbLf & "Der Wert " & Application.WorksheetFunction.Min(arrZahlen) _
      & " 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(arrZahlen(i, 1), arrDaten1, 0)
         If Not IsNumeric(R) Then
            MsgBox "Der Wert " & arrZahlen(i, 1) & "  existiert in der Datenbank nicht!"
            Exit Sub
         End If
      Next i

      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                                  'in Spalte K die Werte abarbeiten
         R = Application.Match(arrZahlen(i, 1), arrDaten1, 0)
         For j = 1 To Takt
            k = 0
            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
         Range("L2") = "'" & i & " / " & lngAnzahl 'Ausgabe Anzahl der Durchläufe
         Range("A1:I1").Offset(0, 0).Resize(Takt) = arr  'Ausgabe der eingelesenen Daten für diesen Durchlauf
      Next i
   End With

End Sub

Der Code ist auch fixer als der vorige.

[Angelina]

hallo atilla

Option Explicit


Variable k =
nicht definiert


LG
Angelina

[atilla]

Hallo Angelina,

Mist, ist noch ein Überbleibsel vom Testen bei mir.
Lösch bitte die Zeile:
k = 0

[Angelina]

Hallo Angelina,

Mist, ist noch ein Überbleibsel vom Testen bei mir.
Lösch bitte die Zeile:
k = 0

hallo,

ok - habe ich gemach - aber es kommen leider ständig Fehlermeldungen
Der Programmablauf hat es wirklich in sich - denke ich!

In K1 habe ich nur die Zahl 800 eingegeben
Takt 20

Fehlermeldung
Laufzeitfehler 13 - Typen unverträglich
R = Application.Match(arrZahlen(i, 1), arrDaten1, 0)


Ebenso wenn ich in K1 1001 eingebe
Takt 20
gleiche Fehlermeldung



hm....

Tut mir echt leid - das ich dir jetzt deine Zeit nehme

aber so geht das testen noch nicht ...


LG
Angelina

[atilla]

Hallo Angelina,

tja, das sind Gegebenheiten, die ich nicht vorausahnen konnte.
Diese Gegebenheit kann vom Feld arrZahlen nicht verarbeitet werden.

Dann teste erst ma so, dass Du in K zwei Zahlen eingibst.
Da ich jetzt unterwegs bin, kann ich den Code nicht anpassen.
Man muss dann arrZahlen mit Zelladressen ersetzen. Ist schnell gemacht.
arrZahlen in Klammern Mus mit diesem Ausdruck:
Range("K1:K" & lngAnzahl).Value
Ersetzt werden.
Alleinstehe vor einer Klammer so: Cells(i, 11)

Vielleicht schaffst Du die Änderung ja selbst.

So bin jetzt doch am PC.
So sollte es dann gehen:

Code:

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 = Range("L1")
  
   'Prüfen ob in Spalte Text vorhanden
   lngAnzahl = Application.WorksheetFunction.Count(Columns(11))
   lngAnzahl2 = Application.WorksheetFunction.CountA(Columns(11))
   If lngAnzahl <> lngAnzahl2 Then
      MsgBox "Kein Text zulässig!"
      Exit Sub
   End If
  
   'Prüfen ob Werte innerhalb von Takt
   If Application.WorksheetFunction.Min(Range("K1:K" & lngAnzahl).Value) - Takt + 1 < 1 Then
      MsgBox "Geht nicht!!!" & vbLf & vbLf & "Der Wert " & Application.WorksheetFunction.Min(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(Cells(i, 11), arrDaten1, 0)
         If Not IsNumeric(R) Then
            MsgBox "Der Wert " & Cells(i, 11) & "  existiert in der Datenbank nicht!"
            Exit Sub
         End If
      Next i

      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                                  'in Spalte K die Werte abarbeiten
         R = Application.Match(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
         Range("L2") = "'" & i & " / " & lngAnzahl 'Ausgabe Anzahl der Durchläufe
         Range("A1:I1").Offset(0, 0).Resize(Takt) = arr  'Ausgabe der eingelesenen Daten für diesen Durchlauf
      Next i
   End With

End Sub

Immer mit der Einschränkung, dass ich nicht alle Eventualitäten voraussehen kann.

[Angelina]

hallo atilla,

bin fleißig am testen.

Da sind mir noch paar Beispiele aufgefallen:

PHP-Code:

In K1 gebe ich 1000 ein und ziehe dann in der Spalte runter bis dort die Zahl 1 steht
Takt habe ich 1 eingegeben

Dann kommt die Meldung
"Der Wert 54 existiert in der Datenbank nicht!"

Der Wert 54 ist aber vorhanden?


-----------------------------------------------------------------------------------------

Gibt man in L1
Takt 0 ein kommt die Meldung

Laufzeitfehler 1004


-----------------------------------------------------------------------------------------
Gebe ich in K1 999 ein und ziehe runter bis Wert 101
Takt 100 oder Takt 99

läuft das Programm ... bis dann eine Fehlermeldung kommt

Laufzeitfehler 9
Index außerhalb des gültigen Bereichs

arr(j - 1, 0) = arrDaten2(R, 1)  'Spalte A einlesen
-----------------------------------------------------------------------------------------

Am schlimmsten ist die Meldung
"Der Wert 54 existiert in der Datenbank nicht!"

K1 1000 runterziehen bis dort 10 steht
Takt 10

o.g. Fehlermeldung
auch wenn ich Takt 9 oder 8 eingebe
----------------------------------------------------------------------------------------- 


Wie gesagt das Programm läuft sehr sehr schnell - tolle Arbeit von dir.

Bin absolut zufrieden - und danke dir sehr sehr dafür!

Das alles kann man/Frau ja nicht ahnen.

Vielleicht findest du ja o.g. Ursache noch

Nochmals vielen lieben Dank - für all deine Zeit / Mühe

Ganz liebe Grüße
Angelina

[atilla]

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.

Arbeitsblatt mit dem Namen 'Daten'
	A	B	C	D	E	F	G	H	I	J
1	1	12	12	13	16	23	41	0		0
2	2	12	12	18	30	32	12	0

Zelle	Formel
J1	=ZÄHLENWENN(A:A;54)

Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg