Discussion:
Bestimmte Anzahl Zeilen einfuegen
(zu alt für eine Antwort)
Volker Neurath
2010-07-08 20:31:48 UTC
Permalink
Hallo zusammen,

ich bastle mal wieder an meinem kleinen Problem.

Ich muss in ein Excel-Sheet (welches ein Antragsformular darstellt)
Artikel einfügen.
Folgende Probleme gibt es dabei:

1. Der Einfügebereich befindet sich mitten im Sheet. Erste freie Zelle ist
B26 ab (IIRC) B38 folgen wieder Zeilen, in denen in anderen Spalten Text
steht.
Der Einfügebereich kann aber nach Bedarf vergrößert werden, d.h. es
dürfen beliebig viele Zeilen eingefügt werden.

2. Die Produktzeilen müssen sauber sortiert nach Geräten
und Zubehör eingefügt werden
in den Bereich ab Zelle B26 kommen die Geräte, darunter das Zubehör.
Problem dabei:
In A26 und darunter sind die Bezeichnungen "Main Units"
Und "Lamps and Lensens" als Bereichskenner - dies muss beachtet werden

Das muss soll in etwa so aussehen

------------------------------------------------------------------------
| Main Units |Art.Nr Gerät|DistriPreis|Händlerpreis|Endkundenpreis
| |Art.Nr Gerät|DistriPreis|Händlerpreis|Endkundenpreis
| |Art.Nr Gerät|DistriPreis|Händlerpreis|Endkundenpreis
+------------+------------+-----------+------------+--------------
| Lenses and |Art.Nr Zubeh|DistriPreis|Händlerpreis|Endkundenpreis
| Options |Art.Nr Zubeh|DistriPreis|Händlerpreis|Endkundenpreis
| |Art.Nr Zubeh|DistriPreis|Händlerpreis|Endkundenpreis
+------------+------------+-----------+------------+--------------

Das Ganze muss unabhängig davon funktionieren, wieviele Produkte insgesamt
angefragt werden.
Zubehör und Geräte können Anhand der Artikelnummer eindeutig unterschieden
werden:

Geräte-Artikelnummern beginnen immer mit V11H
Zubehör (Options) beginnen immer mit V12H
Ersatzteile beginnen immer mit V13H

Wie bekomme ich das hin?
Die Sortierung der Daten auf dem Ausgangssheet habe ich schon hinbekommen.
Aber wie füge ich die sortierten Daten jetzt passend ein?
Kopfzerbrechen bereiten mir hier ganz speziell zwei Dinge:

1. wie füge ich immer die passende Anzahl Zeilen ein?
2 wie erreiche ich, dass diese Zuordnung:

--------------------------+
| Main Units |Art.Nr Gerät|
| |Art.Nr Gerät|
| |Art.Nr Gerät|
+------------+------------+
| Lenses and |Art.Nr Zubeh|
| Options |Art.Nr Zubeh|
| |Art.Nr Zubeh|
+------------+------------+

immer passt. Es darf sich nämlich niemals ein Gerätin den Bereich
"Lenses and Options" verirren und umgekehrt.

Any Ideas? (Andreas ;)

Volker
--
Im übrigen bin ich der Meinung, dass TCPA/TCG verhindert werden muss

Wenn es vom Himmel Zitronen regnet, dann lerne, wie man Limonade macht
Andreas Killer
2010-07-10 05:54:41 UTC
Permalink
Post by Volker Neurath
Wie bekomme ich das hin?
Die Sortierung der Daten auf dem Ausgangssheet habe ich schon hinbekommen.
Aber wie füge ich die sortierten Daten jetzt passend ein?
1. wie füge ich immer die passende Anzahl Zeilen ein?
Hmm, ich dachte ich hätte das schon ausreichend beantwortet...

Vielleicht ist ein praktisches Beispiel besser.

Das Makro geht davon aus das die zu kopierenden Daten in Tabelle1 ab
A26 bis E.. stehen und darunter nix ist.

In Tabelle2 werden die Daten ab B26 bis F.. eingefügt und ich gehe
davon aus das Zeile B27 (mind. F27) beim ersten Kopieren leer ist.

Eine Frage ist noch was mit den Zeilen zwischen letztem Datensatz und
dem Text in B38 passieren soll...?

Mind. eine leere Zeile muss erhalten bleiben, den Rest könnte man
löschen, aber nach welchen Kriterien?

Andreas.

Sub KopiereDaten()
Dim R As Range
With Sheets(1)
'Letzten Preis holen
Set R = .Range("E" & Rows.Count).End(xlUp)
'Datenfeld ab ersten Artikel bis letzter Preis
Set R = .Range(.Range("A26"), R)
'Datenfeld kopieren
R.Copy
End With

With Sheets(2)
'ab B26 einfügen
.Range("B26").Insert Shift:=xlDown

'Letzten Preis von oben suchen
Set R = .Range("F26").End(xlDown)
'Datenfeld ab ersten Artikel bis letzter Preis
Set R = .Range(Range("B26"), R)
'Sortieren nach Artikelnummer
R.Sort Key1:=Range("C26"), Order1:=xlAscending, Header:=xlNo
End With
End Sub
Volker Neurath
2010-07-12 18:38:41 UTC
Permalink
Hi Andreas,
Post by Andreas Killer
Hmm, ich dachte ich hätte das schon ausreichend beantwortet...
Ich habs selber hingekriegt!
Bin richtig stolz drauf, weil ich in EXCEL-VBA bisher ein echtes Greenhorn
bin.
Post by Andreas Killer
Das Makro geht davon aus das die zu kopierenden Daten in Tabelle1 ab
A26 bis E.. stehen und darunter nix ist.
Bei mir sind zwei einfügebereiche untereinander und auch unter dem zweiten
Bereich stehen Daten. Also is nix mit einfach einfügen und kopieren.
Das verbietet sich auch noch aus einem zweiten Grund:
Im Zielbereich sind einige Spalten in anderer Reihenfolge, zudem sind andere
Abstände zwischen den Spalten.
Post by Andreas Killer
Mind. eine leere Zeile muss erhalten bleiben, den Rest könnte man
löschen, aber nach welchen Kriterien?
Andreas.
Sub KopiereDaten()
Dim R As Range
With Sheets(1)
'Letzten Preis holen
Set R = .Range("E" & Rows.Count).End(xlUp)
'Datenfeld ab ersten Artikel bis letzter Preis
Set R = .Range(.Range("A26"), R)
'Datenfeld kopieren
R.Copy
Fehlt da nicht die Zielangabe für Copy?
Post by Andreas Killer
End With
With Sheets(2)
'ab B26 einfügen
.Range("B26").Insert Shift:=xlDown
Das mache ich mit
.Range("26:26").insert

allerdings nicht fix, sondern ich ermittle den einzufügenden Bereich
dynamisch anhand der Zahl der einzufügenden Daten.

Ich würde gern meinen Code hier posten, leider ist www.newsoffice.de derzeit
down (kann auch sein, dass Björn Gottschalkson den einfach kommentarlos
abgeschaltet hat - die seite hat nur noch einen Redirect auf seine
Anwaltskanzlei) und News mit Thunderbird funktionieren aus der 4ma leider
nicht :(

Wenn du also ein gutes HTTP2News Gateway oder auch ein Mail2News Gateway
kennst: immer her damit...

Vorerst werde ich morgen mal den Code meiner Prozedur per Mail an mich
selber schicken und morgen abend hier posten - vielleicht kann man ja was
vereinfachen.

Letzlich fülle ich mit den Quelldaten ein dynamisches Array, das so
gestaltet ist, dass ich es einfach per

Range(Zielrange).value = arr

an den Zielrange übergeben kann, sobald die erforderliche zeilenzahl
hergestellt ist.

Volker
--
Im übrigen bin ich der Meinung, dass TCPA/TCG verhindert werden muss

Wenn es vom Himmel Zitronen regnet, dann lerne, wie man Limonade macht
Andreas Killer
2010-07-13 07:11:33 UTC
Permalink
Post by Volker Neurath
Ich habs selber hingekriegt!
Echt? Ja super! :-))
Post by Volker Neurath
     'Datenfeld kopieren
     R.Copy
Fehlt da nicht die Zielangabe für Copy?
Nö, muss man nicht unbedingt angeben. Und hier verbietet es sich
sogar, weil beim Einfügen gleichzeitig die Zeilen verschoben werden
sollen.
Post by Volker Neurath
Das mache ich mit
  .Range("26:26").insert
BTW, .Range("B26").EntireRow.Insert ist das gleiche. Das braucht man
wenn man dynamisch programmieren möchte und z.B. die Stelle ab die
eingefügt wird mit einem Namen benennt. Vergib mal der Zelle B26 den
Namen "Einfügemarke" und probiers dann so:

.Range("Einfügemarke").EntireRow.Insert

Der Vorteil ist das Excel beim Einfügen/Löschen von Zeilen die
Zellreferenz der benannten Zellbereiche automatisch anpasst. So kann
man später den Kopf vergrößern/verkleinern ohne den Code anpassen zu
müssen.
Post by Volker Neurath
Vorerst werde ich morgen mal den Code meiner Prozedur per Mail an mich
selber schicken und morgen abend hier posten - vielleicht kann man ja was
vereinfachen.
Da bin ich ja mal gespannt. :-)

Andreas.
Volker Neurath
2010-07-13 18:15:47 UTC
Permalink
Post by Andreas Killer
Post by Volker Neurath
Post by Andreas Killer
R.Copy
Fehlt da nicht die Zielangabe für Copy?
Nö, muss man nicht unbedingt angeben. Und hier verbietet es sich
sogar, weil beim Einfügen gleichzeitig die Zeilen verschoben werden
sollen.
Ah, ok -- das geht aus der Literatur, die ich auf'm Schreibtisch habe, nicht
hervor (John Walkenbach "Excel 2003 VBA Power Programming" und "Excel 2007
VBA-programmierung" von Monika Can)
Post by Andreas Killer
Post by Volker Neurath
Das mache ich mit
.Range("26:26").insert
BTW, .Range("B26").EntireRow.Insert ist das gleiche.
Bekannt
Post by Andreas Killer
Das braucht man wenn man dynamisch programmieren möchte und z.B. die
Stelle ab die eingefügt wird mit einem Namen benennt. Vergib mal der Zelle
.Range("Einfügemarke").EntireRow.Insert
Danke für den Tipp.
Post by Andreas Killer
Der Vorteil ist das Excel beim Einfügen/Löschen von Zeilen die
Zellreferenz der benannten Zellbereiche automatisch anpasst.
Das ist mir bekannt. Den Effekt nutze ich gern beim manuellen Arbeiten.
Post by Andreas Killer
So kann man später den Kopf vergrößern/verkleinern ohne den Code anpassen
zu müssen.
Post by Volker Neurath
Vorerst werde ich morgen mal den Code meiner Prozedur per Mail an mich
selber schicken und morgen abend hier posten - vielleicht kann man ja was
vereinfachen.
Da bin ich ja mal gespannt. :-)
Bitte sehr - nicht schön, und ich denke, _du_ wirst hie und da die Hände
über dem kopf zusammenschlagen - aber es funktioniert:

Sub FillProjectorEEMD()
Dim cell As Range
Dim rng As Range

Dim arr() As Variant

Dim r As Integer, c As Integer

Dim lastV11 As Long, ccount As Long, lngletzte As Long
Dim lngFirstRow As Long

ThisWorkbook.Worksheets("Produktliste").Activate

With ThisWorkbook.Worksheets("Produktliste")
lngletzte = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A4:L" & lngletzte).Sort key1:=.Range("B4"), _
order1:=xlAscending

End With

' Range auf Spalte B (Product Code)
Set rng = Range("B4:B" & lngletzte)

'Anzahl Geräte und Zeile letztes Gerät
' Geräte beginnen immer mit V11
'Zubehör mit V12 und Ersatzteile mit V13
For Each cell In rng
If UCase(Left(cell.Value, 3)) = "V11" Then
ccount = ccount + 1
lastV11 = cell.Row
End If
Next

ReDim arr(ccount + 1, 10)

'Range auf Gerätebereich in spalte B
Set rng = Range("B4:B" & lastV11)

r = 0

'Gerätebezogene Werte auslesen und in Array schreiben
For Each cell In rng
With cell
If UCase(Left(.Value, 3)) = "V11" Then
arr(r, 0) = .Value
arr(r, 1) = .Offset(0, -1).Value
arr(r, 2) = .Offset(0, 1).Value
arr(r, 4) = .Offset(0, 7).Value
arr(r, 6) = .Offset(0, 8).Value
arr(r, 8) = .Offset(0, 9).Value

r = r + 1
End If
End With
Next

'Wechsel zu Ziel-Sheet
ThisWorkbook.Worksheets("EEMD projectors").Activate

'Werte für Testsheet. Für EEMD anpassen auf
'B25 für Units
'Zeilen einfügen, falls nötig
If ccount > 2 Then
Range("26:" & 26 + ccount - 3).Insert
End If

'Zielsheet-Range setzen
Set rng = Range("B25:J" & 25 + lastV11 - 2)

'und mit arry-Werten füllen
rng.Value = arr

'zurück zur produktliste
ThisWorkbook.Worksheets("Produktliste").Activate

'Range auf Zubehör setzen
Set rng = Range("B" & lastV11 + 1 & ":B" & lngletzte)

'Array neu dimensionieren...
ReDim arr(lngletzte - lastV11, 10)

'... und füllen
r = 0
For Each cell In rng
With cell
If UCase(Left(.Value, 3)) = "V12" Or _
UCase(Left(.Value, 3)) = "V13" Then
arr(r, 0) = .Value
arr(r, 1) = .Offset(0, -1).Value
arr(r, 2) = .Offset(0, 1).Value
arr(r, 4) = .Offset(0, 7).Value
arr(r, 6) = .Offset(0, 8).Value
arr(r, 8) = .Offset(0, 9).Value

r = r + 1
End If
End With
Next

'Wechsel zu Ziel-Sheet
ThisWorkbook.Worksheets("EEMD projectors").Activate

'erste freie Zelle des Zubehör-bereiches ermitteln
lngFirstRow = 25 'erste zeile des Gesamten zielbereichs

lngFirstRow = lngFirstRow + ccount

'Zeilenzahl im Ziel anpassen, wenn noetig
If lngletzte - lastV11 > 2 Then
Range(CStr(lngFirstRow + 1) & ":" & lngFirstRow + (lngletzte -
lastV11) - 2).Insert
End If

'Zielrange setzen
Set rng = Range("B" & lngFirstRow & ":J" & lngFirstRow + (lngletzte -
lastV11))

'Arrayinhalt einfügen
rng.Value = arr

'Distri und Reseller kopieren
With ThisWorkbook
'erst den distri
.Worksheets("EEMD projectors").Range("F23") =
.Worksheets("Headerdaten").Range("B26")

'dann den Reseller
.Worksheets("Headerdaten").Range("D26") = .Worksheets("EEMD
projectors").Range("H23")

End With

End Sub
----------------------------------

Übrigens sehe ich gerade selber, dass da speziell unter Nutzung deines
Hinweises zu Range(..).Entirerow.Insert noch einiges geht ;)

So gaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaanz langsam machts doch spass ;)

Volker
--
Im übrigen bin ich der Meinung, dass TCPA/TCG verhindert werden muss

Wenn es vom Himmel Zitronen regnet, dann lerne, wie man Limonade macht
Andreas Killer
2010-07-14 10:08:15 UTC
Permalink
Post by Volker Neurath
Bitte sehr - nicht schön, und ich denke, _du_ wirst hie und da die Hände
Ach was, sieht doch sehr gut aus! Alle Variablen deklariert, klare
Struktur, gut kommentiert... und wenn es funktioniert ist alles gut.

Natürlich würde ich einiges anders machen, aber ich bin ja nicht Du
und ob dann mein Code besser ist muss gar nicht sein. Stellt man 10
Programmierern 1 Aufgabe bekommt man 10 verschiedene Lösungen. :-))
Post by Volker Neurath
So gaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaanz langsam machts doch spass ;)
:-)))

Naja, ein paar Feinheiten und eine grundlegende Frage:

Was ich immer sage: Arbeite nie mit Select/Selection/ActiveCell/
Activate, weil das flackert mit dem Bildschirm, ist langsam und bei
Änderungen fehleranfällig. Teilweise hast Du ja WITH-Anweisungen schon
eingearbeitet.

Mit ThisWorkBook brauchst Du nur in dem Fall zu arbeiten wenn gerade
eine andere Mappe aktiv sein kann. Das ist hier nicht der Fall da Du
teileise auch Range direkt aufrufst, was sich dann auf
ActiveWorkBook.ActiveSheet.Range bezieht.

Textvergleiche mit UCase kann man sich schenken wenn man das Modul mit
"Option Compare Text" ausstattet.

Feine Feinheit: Viele String-Routinen können mit einem angehängten $
(Left <> Left$) auch gleich einen Stringtyp zurückgeben. Andernfalls
geben sie einen Variant-Typ zurück. Wenn man schnelle Stringvergleiche
braucht ist StrComp besser.

Auf der anderen Seite kannst Du Routinen die einen String erwarten
auch eine numerische Variable übergeben, VB hat die (un-)angenehme
Eigenschaft die Typ-Umwandlung automatisch selber zu machen. Hier
brauchst Du nicht mit CStr() zuerst einen String erzeugen.

Das Einfügen der Daten in das Zielsheet sieht komisch aus, weil ab
Zeile 26 freigeschoben wird, die Daten aber ab Zeile 25 eingefügt
werden. Das solltest Du mal kontrollieren ob das so richtig ist.

Ein grundlegende Sache verstehe ich jedoch nicht:

Warum suchst Du so aufwendig nach "V11" und überträgst diese Daten
zuerst und erst dann "V12" und "V13"?
Das steht doch nachher eh alles untereinander!?!
Und weil es schon vorher sortiert wurde ist diese "gezwungene"
Reihenfolge überflüssig, das Ergebnis ist gleich!!
Außerdem kann da eh kein anderer Artikel ausser V11,V12,V13
auftauchen, oder doch?
Falls doch funktioniert das kopieren so nicht, da die Zell/Arraygröße
nicht zueinander stimmt.

Ich mach Dir mal eine Anregung dazu unten dran. Das Dimensionieren/
Zuweisen des Array zu dem Range solltest Du Dir genauer ankucken und
(für die Zukunft) übernehmen, ist viel einfacher so und passt immer!

Eine Sache hast Du IMO jedoch nicht bedacht:

Was passiert wenn die Routine ein 2tes Mal aufgerufen wird?
Es könnte ja sein das jemand was vergessen hat und die Produktliste
ergänzt und dann nochmal die Routine aufruft, oder nicht?

In diesem Fall gibt es mit Deiner Routine Datensalat, bei der
angehängten müsstest Du (zusätzlich) alle Daten im Zielsheet sortieren
und ggf. doppelte Einträge löschen.

(Und ggf. überschüssige Leerzeilen löschen? Ich verstehe den Sinn
hinter dem Code
If ccount > 2 Then
Range("26:" & 26 + ccount - 3).Insert
nicht.)

Andreas.

Option Explicit

Sub FillProjectorEEMD()
Dim cell As Range
Dim rng As Range
Dim arr() As Variant
Dim lngletzte As Long, r As Long

With Worksheets("Produktliste")
'Letzte Zeile Spalte A
lngletzte = .Cells(Rows.Count, 1).End(xlUp).Row
'Datenbereich A4:L? holen
Set rng = .Range(.Range("A4"), .Range("L" & lngletzte))
'(Sicherheit um z.B. "A4:L3" zu vermeiden!)
If rng.Row <> 4 Then Exit Sub

'Nach Product Code sortieren
rng.Sort key1:=.Range("B4"), order1:=xlAscending

'Ein Array mit Basis 1 ist einfacher mit Range.Resize!
ReDim arr(1 To rng.Rows.Count, 1 To 9)

'Durchlaufe Spalte B (Product Code)
r = 1
For Each cell In Intersect(rng, .Columns(2))
'Gerätebezogene Werte auslesen und in Array schreiben
With cell
arr(r, 1) = .Value
arr(r, 2) = .Offset(0, -1).Value
arr(r, 3) = .Offset(0, 1).Value
arr(r, 5) = .Offset(0, 7).Value
arr(r, 7) = .Offset(0, 8).Value
arr(r, 9) = .Offset(0, 9).Value
r = r + 1
End With
Next
End With

'Wechsel zu Ziel-Sheet
With Worksheets("EEMD projectors")
'Zeilen einfügen
.Range("B25").Resize(UBound(arr)).EntireRow.Insert
'Werte eintragen
.Range("B25").Resize(UBound(arr), UBound(arr, 2)).Value = arr
End With

'Distri und Reseller kopieren
'erst den distri
Worksheets("EEMD projectors").Range("F23") = _
Worksheets("Headerdaten").Range("B26")

'dann den Reseller
Worksheets("Headerdaten").Range("D26") = _
Worksheets("EEMD projectors").Range("H23")
End Sub
Volker Neurath
2010-07-14 20:50:17 UTC
Permalink
Hi Andreas,
Post by Andreas Killer
Ach was, sieht doch sehr gut aus! Alle Variablen deklariert, klare
Struktur, gut kommentiert... und wenn es funktioniert ist alles gut.
Es funktioniert - aber mir hat z.B. die doppelte For-Schleife keine ruhe
gelassen - und nach deinem Hinweis bezüglich Named-Ranges habe ich das dann
gleich heute in die Tat umgesetzt.
Ergebnis: statt 2 A4 Seiten benötigt der Code nur noch eine, Code hängt
unten dran.
Post by Andreas Killer
Natürlich würde ich einiges anders machen, aber ich bin ja nicht Du
und ob dann mein Code besser ist muss gar nicht sein. Stellt man 10
Programmierern 1 Aufgabe bekommt man 10 verschiedene Lösungen. :-))
Das kommt mir bekannt vor ;)
Post by Andreas Killer
Was ich immer sage: Arbeite nie mit Select/Selection/ActiveCell/
Activate, weil das flackert mit dem Bildschirm, ist langsam und bei
Änderungen fehleranfällig.
Stimmt. Deswegen habe ich im neuen Code auch Application.Screenupdating
genutzt. Ich übe noch ;)

Was die beiden Worksheet(..).Activate betrifft:
die sind bewusst drin im code, da der Aussendienstler das, was er
"verbrochen" hat, auch kontrollieren soll ;)

Am liebsten wäre mir im übrigen, der AD müsste gar nicht erst einen Button
betätigen, damit der Code ausgeführt wird - bin aber noch unschlüssig, wohin
ich die Prozedur noch legen könnte, um eine automatische Ausführung zu
errreichen.
Post by Andreas Killer
Mit ThisWorkBook brauchst Du nur in dem Fall zu arbeiten wenn gerade
eine andere Mappe aktiv sein kann.
Das ist hier nicht der Fall
da bin ich mir nicht sicher. Die Mappe geht in kürze an unsere
Aussendienstler - und ob die außer dieser Mappe noch was anderes offen
haben, weiss ich nicht - zumindest ist es nicht unwahrscheinlich.
Post by Andreas Killer
Feine Feinheit: Viele String-Routinen können mit einem angehängten $
(Left <> Left$) auch gleich einen Stringtyp zurückgeben.
Das vergesse ich immer wieder obwohl ich es von Access her weiss.
Post by Andreas Killer
Das Einfügen der Daten in das Zielsheet sieht komisch aus, weil ab
Zeile 26 freigeschoben wird, die Daten aber ab Zeile 25 eingefügt
werden. Das solltest Du mal kontrollieren ob das so richtig ist.
Das ist so richtig.
In dem Sheet sind, wie gesagt, zwei Einfügebereiche - je einer für Main
Units und Options.
Im leeren Sheet besteht jeder der Bereiche aus zwei leeren Zeilen. Mein code
fügt, für den Fall dass mehr als 2 Artikel für einen Bereich vorliegen, ab
Zeile 26 (für den Bereich "Main Units") soviele Leerzeilen ein, wie
zusätzlich zu den beiden vorhandenen benötigt werden.
Post by Andreas Killer
Warum suchst Du so aufwendig nach "V11" und überträgst diese Daten
zuerst und erst dann "V12" und "V13"?
Das steht doch nachher eh alles untereinander!?!
Und weil es schon vorher sortiert wurde ist diese "gezwungene"
Reihenfolge überflüssig, das Ergebnis ist gleich!!
Genau das habe ich heute geändert.
Post by Andreas Killer
Außerdem kann da eh kein anderer Artikel ausser V11,V12,V13
auftauchen, oder doch?
Leider zumindest theoretisch doch. Es wäre durchaus möglich, dass ein
kollege ein Projekt, bestehend aus Projektoren, Projektorzubehör und
Druckern einreicht.
In das fragliche Formular dürfen aber nur Projektoren und Zubehör.
Post by Andreas Killer
Falls doch funktioniert das kopieren so nicht, da die Zell/Arraygröße
nicht zueinander stimmt.
Was passt da nicht / habe ich übersehen?
Post by Andreas Killer
Was passiert wenn die Routine ein 2tes Mal aufgerufen wird?
Es könnte ja sein das jemand was vergessen hat und die Produktliste
ergänzt und dann nochmal die Routine aufruft, oder nicht?
Yo, das könnte passieren.
Post by Andreas Killer
(Und ggf. überschüssige Leerzeilen löschen? Ich verstehe den Sinn
hinter dem Code
If ccount > 2 Then
Range("26:" & 26 + ccount - 3).Insert
nicht.)
Wenn mehr als 2 Artikel für den Bereich "Main Units" erfasst wurden, ist
ccount >2
Also werden entsprechend viele Leerzeilen zugefügt, bevor dann das Arry
eingefügt wird.

[code gesnipped]

Deinen code habe ich mir gerade ins Büro geschickt - analysiere ich morgen.

hier ist nun mein neuer Code:

Sub EEMDFillNew()
Dim cell As Range
Dim rng As Range

Dim arr() As Variant

Dim r As Integer, c As Integer

Dim lastV11 As Long, lngLastOption As Long, lngUnitCount As Long,
lngLetzte As Long
Dim lngOptionCount As Long, lngFirstRow As Long

ThisWorkbook.Worksheets("Produktliste").Activate

With ThisWorkbook.Worksheets("Produktliste")
lngLetzte = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A4:L" & lngLetzte).Sort key1:=.Range("B4"),
order1:=xlAscending

End With

' Range auf Spalte B (Product Code)
Set rng = Range("B4:B" & lngLetzte)

' anzahl Units und anzahl options ermitteln
For Each cell In rng
If UCase(Left(cell.Value, 3)) = "V11" Then
lngUnitCount = lngUnitCount + 1
lastV11 = cell.Row
ElseIf UCase(Left(cell.Value, 3)) = "V12" Or UCase(Left(cell.Value,
3)) = "V13" Then
lngOptionCount = lngOptionCount + 1
lngLastOption = cell.Row
End If
Next

'array dimensionieren...
ReDim arr(lngUnitCount + lngOptionCount + 1, 10)

'und füllen
For Each cell In rng
With cell
arr(r, 0) = .Value
arr(r, 1) = .Offset(0, -1).Value
arr(r, 2) = .Offset(0, 1).Value
arr(r, 4) = .Offset(0, 7).Value
arr(r, 6) = .Offset(0, 8).Value
arr(r, 8) = .Offset(0, 9).Value

r = r + 1

End With
Next

'Zum Zielsheet wechseln
ThisWorkbook.Worksheets("Test").Activate

'Für die nachfolgenden Arbeiten Screenaktualisierung abschalten
Application.ScreenUpdating = False

'Zusätzliche Zeilen einfügen falls nötig
'Zuerst im Unit-Bereich
If lngUnitCount > 2 Then
For c = 1 To lngUnitCount - 2
Range("EEMD_units").EntireRow.Insert
Next c
End If

'...dann im Options Bereich
If lngOptionCount > 2 Then
For c = 1 To lngOptionCount - 2
Range("EEMD_options").EntireRow.Insert
Next c
End If

'array einfügen
Range("EEMD_products").Value = arr

'Screenaktualisierung ein
Application.ScreenUpdating = True

End Sub
--
Im übrigen bin ich der Meinung, dass TCPA/TCG verhindert werden muss

Wenn es vom Himmel Zitronen regnet, dann lerne, wie man Limonade macht
Andreas Killer
2010-07-15 07:16:31 UTC
Permalink
Post by Volker Neurath
Am liebsten wäre mir im übrigen, der AD müsste gar nicht erst einen Button
betätigen, damit der Code ausgeführt wird - bin aber noch unschlüssig, wohin
ich die Prozedur noch legen könnte, um eine automatische Ausführung zu
errreichen.
Naja, man könnte das Change-Ereignis nutzen, aber ich würde das nicht
machen.
Post by Volker Neurath
Post by Andreas Killer
Mit ThisWorkBook brauchst Du nur in dem Fall zu arbeiten wenn gerade
eine andere Mappe aktiv sein kann.
Das ist hier nicht der Fall
da bin ich mir nicht sicher. Die Mappe geht in kürze an unsere
Aussendienstler - und ob die außer dieser Mappe noch was anderes offen
haben, weiss ich nicht - zumindest ist es nicht unwahrscheinlich.
Das wäre egal, denn wenn der User auf den Button klickt, dann ist er
gerade in der Mappe und nicht in einer anderen.

Und wenn Du am Ende der Entwicklung ein "Option Private Module" in das
Modul schreibst, dann ist es auch nicht mehr möglicht via Alt-F8 das
Makro von einer anderen Mappe aus aufzurufen.
Post by Volker Neurath
Post by Andreas Killer
Außerdem kann da eh kein anderer Artikel ausser V11,V12,V13
auftauchen, oder doch?
Leider zumindest theoretisch doch. Es wäre durchaus möglich, dass ein
...
Post by Volker Neurath
Post by Andreas Killer
Falls doch funktioniert das kopieren so nicht, da die Zell/Arraygröße
nicht zueinander stimmt.
Was passt da nicht / habe ich übersehen?
Ganz einfach, stellt Dir mal vor es stehen nur Artikel mit V14 in der
Liste. Dann wird Dein Array so groß dimensioniert wie die Liste ist,
aber es würde in diesem Fall keine Daten enthalten.

Also würdest Du einen leeren Block in das Zielsheet importieren.
Solange das Array > als der defnierte Zellbereich ist, ist's nicht so
schlimm, wenn's kleiner wird bekommst Du #NV in den überschüssigen
Zellen.
Post by Volker Neurath
Post by Andreas Killer
Was passiert wenn die Routine ein 2tes Mal aufgerufen wird?
Es könnte ja sein das jemand was vergessen hat und die Produktliste
ergänzt und dann nochmal die Routine aufruft, oder nicht?
Yo, das könnte passieren.
Dann musst Du Deine Routine komplett überarbeiten, das geht so nicht.

Andreas.
Volker Neurath
2010-07-15 17:54:54 UTC
Permalink
Post by Andreas Killer
Post by Volker Neurath
Post by Andreas Killer
Falls doch funktioniert das kopieren so nicht, da die Zell/Arraygröße
nicht zueinander stimmt.
Was passt da nicht / habe ich übersehen?
Ganz einfach, stellt Dir mal vor es stehen nur Artikel mit V14 in der
Liste. Dann wird Dein Array so groß dimensioniert wie die Liste ist,
aber es würde in diesem Fall keine Daten enthalten.
Stimmt auffallend. Da mussich wohl doch nochmal ran.
Post by Andreas Killer
Post by Volker Neurath
Post by Andreas Killer
Was passiert wenn die Routine ein 2tes Mal aufgerufen wird?
Es könnte ja sein das jemand was vergessen hat und die Produktliste
ergänzt und dann nochmal die Routine aufruft, oder nicht?
Yo, das könnte passieren.
Dann musst Du Deine Routine komplett überarbeiten, das geht so nicht.
Lass ich mir auch was zu einfallen.
Hast du evtl. eine Idee, wie man das dadurch entstehende Chaos vermeiden
kann?

Volker
--
Im übrigen bin ich der Meinung, dass TCPA/TCG verhindert werden muss

Wenn es vom Himmel Zitronen regnet, dann lerne, wie man Limonade macht
Andreas Killer
2010-07-16 07:09:01 UTC
Permalink
Post by Volker Neurath
Hast du evtl. eine Idee, wie man das dadurch entstehende Chaos vermeiden
kann?
Die Frage ist wie ist das grundlegende Konzept?

Möglichkeiten:

Es werden generell nur Daten aus Produktliste nach EEMD geschrieben,
dabei werden alte Daten gelöscht.

Es werden Daten aus Produktliste nach EEMD geschrieben, alte Daten
können aus EEMD nach Produktliste importiert werden, Dublikate bleiben
erhalten.

Es werden Daten aus Produktliste nach EEMD geschrieben, alte Daten
können aus EEMD nach Produktliste importiert werden, Dublikate werden
gelöscht.

Es werden generell nur Daten aus Produktliste nach EEMD geschrieben,
dabei werden alte Daten erweitert, Dublikate bleiben erhalten.

Es werden generell nur Daten aus Produktliste nach EEMD geschrieben,
dabei werden alte Daten erweitert, Dublikate werden gelöscht.

Es gibt sicher noch andere denkbare Lösungen. Musst Du mal mit dem
Aussendienst besprechen wie sie es gerne hätten, bzw. was sinnvoll
ist. Erst wenn das klar ist kannst Du anfangen zu programmieren.

Andreas.
Volker Neurath
2010-07-17 19:34:32 UTC
Permalink
Post by Andreas Killer
Es werden generell nur Daten aus Produktliste nach EEMD geschrieben,
dabei werden alte Daten erweitert, Dublikate werden gelöscht.
Genau das ist die richtige Variante:
Bereits vorhandene Daten bleiben erhalten, neues aus Produktliste wird
zugefügt, Duplikate entfernt

Volker
--
Im übrigen bin ich der Meinung, dass TCPA/TCG verhindert werden muss

Wenn es vom Himmel Zitronen regnet, dann lerne, wie man Limonade macht
Andreas Killer
2010-07-18 14:25:55 UTC
Permalink
Post by Volker Neurath
Post by Andreas Killer
Es werden generell nur Daten aus Produktliste nach EEMD geschrieben,
dabei werden alte Daten erweitert, Dublikate werden gelöscht.
Bereits vorhandene Daten bleiben erhalten, neues aus Produktliste wird
zugefügt, Duplikate entfernt
Okay, ist eine der komplizierteren Varianten. Ich schmeiß nochmal ein
weitere dazu:

Bereits vorhandene Daten bleiben erhalten, neues aus Produktliste wird
zugefügt, Duplikate werden zusammengefasst (Stückzahl wird erhöht).
Was hälst Du davon?

Andreas.

Volker Neurath
2010-07-15 17:59:14 UTC
Permalink
Hi nochmal,
Post by Andreas Killer
'Durchlaufe Spalte B (Product Code)
r = 1
For Each cell In Intersect(rng, .Columns(2))
Wozu dient hier das Intersect?
Post by Andreas Killer
'Wechsel zu Ziel-Sheet
With Worksheets("EEMD projectors")
'Zeilen einfügen
.Range("B25").Resize(UBound(arr)).EntireRow.Insert
'Werte eintragen
.Range("B25").Resize(UBound(arr), UBound(arr, 2)).Value = arr
End With
was genau passiert in diesem With Block?
Speziell interessieren mich Detail zu den beiden Range(..) Anweisungen

Volker
--
Im übrigen bin ich der Meinung, dass TCPA/TCG verhindert werden muss

Wenn es vom Himmel Zitronen regnet, dann lerne, wie man Limonade macht
Andreas Killer
2010-07-16 07:18:14 UTC
Permalink
Post by Volker Neurath
    For Each cell In Intersect(rng, .Columns(2))
Wozu dient hier das Intersect?
Das Intersect liefert hier aus dem ganzen Bereich aller Daten nur die
2te Spalte.
Post by Volker Neurath
  'Wechsel zu Ziel-Sheet
  With Worksheets("EEMD projectors")
    'Zeilen einfügen
    .Range("B25").Resize(UBound(arr)).EntireRow.Insert
    'Werte eintragen
    .Range("B25").Resize(UBound(arr), UBound(arr, 2)).Value = arr
  End With
was genau passiert in diesem With Block?
Speziell interessieren mich Detail zu den beiden Range(..) Anweisungen
Wenn Du Daten aus einem Array in einen Zellbereich einfügen möchtest,
dann ist es wichtig das der Zellbereich 100% so groß ist wie das
Array.

Um sich komplizierte Rechenkunststücke ala
Range("B" & lngFirstRow & ":J" & lngFirstRow + (lngletzte -
lastV11))
zu ersparen nimmt man einfach die erste Zelle ab der die Daten
reinsollen und vergrößert sie um die Größe des Array. Und wenn das
Array(1 to irgendwas, 1 to irgendwas) dimensioniert ist, dann ist die
Zeilenanzahl UBound(arr) und die Spaltenanzahl UBound(Arr,2).

Ganz einfach und stimmt immer.

Andreas.
Volker Neurath
2010-07-17 19:32:18 UTC
Permalink
Post by Andreas Killer
Das Intersect liefert hier aus dem ganzen Bereich aller Daten nur die
2te Spalte.
[...]
Post by Andreas Killer
Wenn Du Daten aus einem Array in einen Zellbereich einfügen möchtest,
dann ist es wichtig das der Zellbereich 100% so groß ist wie das
Array.
Um sich komplizierte Rechenkunststücke ala
Range("B" & lngFirstRow & ":J" & lngFirstRow + (lngletzte -
lastV11))
zu ersparen nimmt man einfach die erste Zelle ab der die Daten
reinsollen und vergrößert sie um die Größe des Array. Und wenn das
Array(1 to irgendwas, 1 to irgendwas) dimensioniert ist, dann ist die
Zeilenanzahl UBound(arr) und die Spaltenanzahl UBound(Arr,2).
Ganz einfach und stimmt immer.
THX.

Volker
--
Im übrigen bin ich der Meinung, dass TCPA/TCG verhindert werden muss

Wenn es vom Himmel Zitronen regnet, dann lerne, wie man Limonade macht
Loading...