Gefilterte Daten transferieren
Klaus Heinrich
ich schlage micht mit folgendem Problem rum:
In einem Tabellenblatt wurde ein Autofilter gesetzt. Über VBA möchte ich
den Inhalt genau
einer Zelle aus dem gefilterten Bereich auf ein anderes Blatt übertragen.
Mit folgendem Coding markiere ich bereits die richtige Spalte, in der
die Kundennummer
in jeder Zeile die gleiche ist:
'Kundenummer aus dem gefilterten Bereich ins Rechnungsblatt übertragen
With ActiveSheet.AutoFilter.Range
.Offset(1, 1).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible).Copy
' Destination:=Worksheets("Rechnung").Range("F13")
End With
Wie muss die Resize-Anweisung aussehen, damit ich nicht die ganze Spalte
sondern
nur die erste ( oder letzte ) Zeile selektiere ?
Besten Dank im Voraus und Gruß
Klaus
Ullrich Schwarz
vielleicht etwas in der Art (3 Zeilen):
Set rg = ActiveSheet.AutoFilter.Range
rg.Resize(rg.Rows.Count - 1, 1).Offset(1,
0).SpecialCells(xlCellTypeVisible).Copy _
Destination:=Worksheets("Rechnung").Range("F13")
--
MfG Ullrich
- Excel 2000 -
"Klaus Heinrich" <te...@test.de> schrieb im Newsbeitrag
news:dhs69v$t7r$1...@ulysses.news.tiscali.de...
Klaus Heinrich
danke für die schnelle Antwort. Ich hab den Offset noch auf
1,1 angepaßt, aber leider wird nicht nur eine Zeile selektiert,
sondern mehrere
Was kann ich tun ?
Gruß Klaus
Ullrich Schwarz schrieb:
Klaus Heinrich
eigentlich bräuchte ich etwas wie:
Set rg = ActiveSheet.AutoFilter.Range
rg.Resize(1, 1).Offset(1, 1).SpecialCells(xlCellTypeVisible).Copy _
^^^^^
Destination:=Worksheets("Rechnung").Range("F13")
aber der Resize auf 1,1 greift dann den ganzen Bereich
Gruß Klaus
Ullrich Schwarz
die Proz kopiert die Spalte A aus allen per Autofilter
angezeigten Datensätze. Welche Zeile willst Du denn
kopieren?
--
MfG Ullrich
- Excel 2000 -
"Klaus Heinrich" <te...@test.de> schrieb im Newsbeitrag
news:dhs844$tgt$1...@ulysses.news.tiscali.de...
RaiStahl
"Klaus Heinrich" wrote:
> ....
> eigentlich bräuchte ich etwas wie:
>
> Set rg = ActiveSheet.AutoFilter.Range
> rg.Resize(1, 1).Offset(1, 1).SpecialCells(xlCellTypeVisible).Copy _
> ^^^^^
ohne, daß ich es probiert habe, würde ich die Eigenschaften/Methoden anders
ordnen:
rg.SpecialCells(xlCellTypeVisible).Resize(1, 1).Offset(1, 1).Copy
Ansonsten habe ich mal ein ähnliches Problem mit einer Schleife der
folgenden Art gelöst:
For each rg in ActiveSheet.AutoFilter.Range.cells
if rg.visible then <wenn gewünschte Zeile erreicht, dann kopieren>
next rg
Leider weiß ich nicht mehr genau, wie es lief... aber das oben ist der
damaligen Lösung schon ziemlich nahe.
Gruß
Rainer
Klaus Heinrich
ich möchte nur eine Zelle kopieren, dabei ist es egal ob die erste Zeile
oder die letzte Zeile, weil in dieser Spalte die Kundennumer steht
und die ist in meinem Fall immer gleich.
Also hier noch mal der Pseudocode meines Problems:
nimm aus dem gefilterten Bereich
die Zelle mit einem Offset 1,1 kopiere sie
und übertrage sie auf das Rechnungsblatt
Gruß Klaus
Ullrich Schwarz schrieb:
>Hallo Klaus,
klaus.schmitz
ich wollte Dir gestern eine Makrocode posten
und weil ich immer alles vorher ausprobiere was
ich hier poste bin ich auf eine ulkige Art und Weise
auf eine Ungleichbehandlung von Code aufmerksam
geworden.
Für Excel VBA gibt es einen Unterschied ob der
Code in einem Modul steht oder in dem Arbeitsblatt.
Ich habe für Dich einen Makrocode PikUp gebaut
den Du ganz einfach für das Kopieren von einem
Tabellenblatt in ein anderes verwenden kannst.
Damit nichts schief geht probiere zunächst einmal
mit einer leeren Arbeitsmappe aus und schreibe
in die Spalte A von A5 bis A10 irgend einen Text.
sodann stelle den Cursor in eine der Zeilen zwischen
5 und 10 und betätige den Button.
Du brauchst nichts zu markieren, das Ding
kopiert einfach von einem Blatt zum anderen.
Die Quelladresse und die Zieladresse kannst Du
beliebig ändern.
Hier der Code:
Sub PikUp_Click()
Worksheets("Tabelle2").Range("A" & ActiveCell.Row).Value = _
Range("A" & ActiveCell.Row).Value
Range("Tabelle1!A" & ActiveCell.Row + 1).Activate
End Sub
Viel Spaß beim Ausprobieren.
MfG
Klaus
Klaus Heinrich
besten Dank für Deine Antwort. Funktioniert das Coding auch mit
Autofilter ?
Gruß Klaus
klaus.schmitz schrieb:
klaus.schmitz
beim Autofilter wird ja nichts anderes gemacht
als eine gekürzte Tabelle mit gefilterte Zeilen.
Die Zeilennummern bleiben dabei erhalten.
Ich habe mein Muster mit dem Autofilfer
soeben ausprobiert und es läuft einwandfrei.
Wenn Du den Cursor in eine der gefilterten Zeilen
stellst und dann den Button anklickst, dann wird
die Zelle der Spalte A der Tabelle 1 in die Spalte A
der Tabelle 2 kopiert.
Aber Vorsicht,
ich habe in diesen Code den Sprung zur nächsten
Zeile eingebaut.
Dieser Sprung macht zwar keine Probleme,
kann aber zur Verwirrung führen, denn wenn
Du gefilterte Daten hast, dann ist der Sprung zur
nächsten Zeile eben nicht eine Zeile sodern
eine unbekannte Weite.
Was da passiert kann ich Dir sagen, der Makro
kopiert auch die nicht sichtbaren Zeilen rüber
in die Tabelle 2 bis er in der nächsten gefilterten
Zeile ankommt.
Wenn Du also damit kopieren willst, dann mußt
Du nach dem Kopieren mit dem Corsor die Zeile
anspringen, die Du kopieren willst oder die
unterste Zeile aus dem Makro mit Hochkomma
inaktivieren.
Noch eines mußt Du bei gefilterten Zeilen beachten
ziehe dort niemals eine Formel oder sowas nach
unten, weil dann kann es Dir passieren, daß Du
dann die Daten die zwischen den gefilterten Zeilen
liegen überschreibst.
Weil ich Dir ein ganz einfaches Muster gestrickt habe
wird die Kopie genau in der gleichen Zeile landen
wie die Quelle.
Das heißt, wenn Du etwas aus Zeile 10 kopierst,
dann wird es auch in der Zeile 10 der 2. Tabelle landen.
Wenn Du da etwas anderes möchtest, dann schreibe
hier was Du willst und ich baue es Dir.
MfG
Klaus
Klaus Heinrich
besten Dank für Deine umfangreichen Erläuerungen.
Ich beschreibe meine Aufgabenstellung vielleicht mal komplett,
dann wird es einfacher einen Lösungsansatz zu finden:
In einer Tabelle "Termine" werden folgende Daten erfaßt:
Spalte A leer
Spalte B Lfd. Nr
Spalte C Datum
Spalte D Kd. Nummer
Spalte E Kundenname ( erzeugt über Verweis )
Spalte F Art. Nr.
Spalte G Betrag
Spalte H Rechnungsnummer
Über die Spalten B bis H liegt ein Autofilter. In Regelmäßigen Abständen
filtere ich alle Einträge, bei denen Rechnungsnummer = leer ist und danach
nach einer gefundenen Kundennummer.
Damit erhalte ich alle Termine ( Spalte C) und Artikel-Nr. (Spalte F),
die noch
abzurechnen sind.
Über einen Button auf dem Tabellenblatt Termine "Übergabe an Rechnung"
wird nun folgendes Coding ausgeführt:
'Übergibt Daten aus dem Terminblatt in die Rechnung
Sub Uebergabe_An_Rechnung()
Dim rng As Range
Dim anz As Integer
Dim i As Integer
Application.ScreenUpdating = False
'Rechnungsblatt leeren
ThisWorkbook.Sheets("Rechnung").Activate
'Datum löschen
Range("B18:B40").Select
Selection.ClearContents
'Artikel löschen
Range("C18:C40").Select
Selection.ClearContents
'Anzahl löschen
Range("F18:F40").Select
Selection.ClearContents
'Termine kopieren und einfügen
ThisWorkbook.Sheets("Termine").Activate
With ActiveSheet.AutoFilter.Range
.Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible).Copy _
Destination:=Worksheets("Rechnung").Range("B18")
Application.CutCopyMode = False
End With
'Artikel kopieren und einfügen
With ActiveSheet.AutoFilter.Range
.Offset(1, 3).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible).Copy _
Destination:=Worksheets("Rechnung").Range("C18")
Application.CutCopyMode = False
End With
'Rahmen reparieren
ThisWorkbook.Sheets("Rechnung").Activate
Range("C18:C40").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
'Anzahl eintragen ( ist immer 1 )
ThisWorkbook.Sheets("Termine").Activate
Set rng = ActiveSheet.AutoFilter.Range
anz = rng.Columns(1).SpecialCells(xlVisible).Count - 1
For i = 0 To anz - 1
Worksheets("Rechnung").Cells(i + 18, 6).Value = 1
Next
'Kundenummer aus dem gefilterten Bereich ins Rechnungsblatt übertragen
dieses Coding fehlt noch
Pseudocode ( nimm die erste Zeile aus dem gefilterten Bereich, davon die
Spalte D
und übertrage sie in das Tabellenblatt Rechnung nach F13 ( ohne Rahmen )
Ob die erste oder letzte Zeile ist egal, da ja nach Kunden gefiltert wurde
Folgendes Coding selektiert die gesamte Spalte mit den Kundennummern,
ich möchte aber nur eine Zelle mit der Kundennummer:
With ActiveSheet.AutoFilter.Range
.Offset(1, 1).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible).Copy
' Destination:=Worksheets("Rechnung").Range("F13")
'End With
Der Offset 1,1 kommt daher, weil Spalte A leer ist, Spalte B das
Datum enthält und daher über den Offset 1,1 die Spalte C
angesprochen wird. Leider gelingt mir kein RESIZE auf nur genau
eine Zelle der gefilterten Spalte, egal ob erste oder letzte des
SpecialCells(xlCellTypeVisible).
Application.ScreenUpdating = True
MsgBox "Daten wurden ins Rechnungsformular übertragen"
End Sub
Vielen Dank für die Mühe
Gruß Klaus
klaus.schmitz schrieb:
klaus.schmitz
also gut dann wollen wir uns mal an die Arbeit machen.
Ich schreibe Dir hier, wie ich das machen würde und
bringe Dich schrittweise ans Ziel.
Dein Autofilter ist nicht so ganz nach meinem Geschmack,
deshalb würde ich Dir den Spazialfilter per VBA empfehlen.
Um das alles nach meinen Vorstellungen zu realisieren
mußte ich die Überschriften Deiner Spalten geringfügig
ändern weil das Mit Punkten und Leerzeichen dazwischen
nicht so ganz günstig ist.
Speichere Deine Arbeitsmappe mit Speichern Unter unter
einem Neuen Namen ab, damit Dir Deine alten Daten erhalten
bleiben.
Sodann ändere die Beschiftung der Spalten wie folgt:
A leerX
B LfdNr
C Datum
D KdNummer
E KundenName
F ArtNum
G Betrag
H ReNum
Nenne die Spalte wirklich leerX, denn ohne Beschriftung
oben können wir die Spalte nicht gebrauchen.
Sodann sorge durch einfügen von Zeilen dafür, daß Deine
Überschriften in der Zeile 4 stehen und die Daten in der
Zeile 5 anfangen.
Nun lege eine Neue Tabelle in dem Arbeitsblatt an
und nenne diese Tabelle DatenAuszug.
Kopiere die Kopfzeile aus Deiner Datentabelle, die Du
Termin genannt hat in die Zeile 4 der Tabelle Datenauszug
Nun verändere die Zeilenhöhe der Zeile 1 in der Tabelle
Datenauszug so, das diese ca. 2 cm hoch ist.
Nun platziere in diese breite Zeile Zwei Makrobuttons.
Mir ist es egal ob einfachen Button oder CommandButton
wichtig ist nur, daß Du es hinkriegst den folgenden Makro
"DatenAuszug" einzubauen.
Den Makro Neuzeile brauchen wir später.
Sub DatenAuszug()
Rows("10:1000").EntireRow.Delete
Sheets("HauptTabelle").Range("A4:H3000").AdvancedFilter
Action:=xlFilterCopy, _
CriteriaRange:=Range("A4:H5"), CopyToRange:=Range("A10"),
Unique:=False
End Sub
Bei meiner Überlegung bin ich zunächst davon ausgegangen, daß Deine
Datentabelle nicht mehr als 3000 Zeilen hat. Das läßt sich aber ganz
einfach logisch ändern.
Weiterhin gehe ich davon aus, daß Du in der Spalte B immer eine
Zahl oder eine Zahl mit Text als laufende Nummer hast, denn
dann können wir mit der Spalte B rechnen.
Sub NeuzeileDatenAuszug()
Dim BelegteZeilen
BelegteZeilen = Application.CountA(Range("B10:B3000").Value)
Range("A" & 10 + BelegteZeilen).Select
End Sub
Nun wenn Du diese Arbeit gemacht hast, dann weise den
Buttons jeweils einen Makro zu.
Nimm irgend eine Kundennummer aus Deiner Datentabelle
und tippe diese in die Zelle D5 in der Tabelle datenauszug
sodann lasse den Makro Datenauszug anspringen und schaue
Dir an was passiert.
Genauso kannst Du jeden beliebigen Text oder auch
Zahl die in der Spalte der Datentabelle vorkommt dort
eingeben und schon bekommst Du Deinen Datenauszug.
Für den Moment genug,
probiere aus und melde Dich wieder,
dann geht es weiter.
MfG
Klaus
klaus.schmitz
ich habe vergessen in dem Makro das Wort
HauptTabelle gegen Deinen TabellenNamen
Termine zu tauschen.
Entferne also Das Wort HauptTabelle aus dem
Makro und schreibe statt dessen Deinen
TabellenNamen Termine rein.
MfG
Klaus
Klaus Heinrich
Gruß Klaus
Ullrich Schwarz schrieb:
>Hallo Klaus,
Ullrich Schwarz
unabhängig vom Fortgang der Diskussion der ergänzte Code (2 Zeilen):
Set rg = ActiveSheet.AutoFilter.Range
Worksheets("Rechnung").Range("F13") = rg.Resize(rg.Rows.Count - 1, 1).Offset(1,
0).SpecialCells(xlCellTypeVisible).Cells(1).Value
Hier wird also der Wert aus der Spalte A und der ersten sichtbaren Zeile
"geholt". Falls eine andere Spalte gewünscht ist, einfach die
OFFSET-Eigenschaft ändern (z.B. für Spalte B: Offset(1, 1).
--
MfG Ullrich
- Excel 2000 -
"Klaus Heinrich" <te...@test.de> schrieb im Newsbeitrag
news:dhucp4$188a$1...@ulysses.news.tiscali.de...
Klaus Heinrich
einfach genial, offset angepaßt, knöbsche gedrüggt und fettich ;-)
Verstehe das coding zwar nicht, aber es läuft.
Besten Dank
Ullrich Schwarz schrieb:
>Hallo Klaus,
>
Klaus Heinrich
ein Umbau auf das Spezialfilter hat sich nun erübrigt wie Du oben siehst.
Dennoch vielen Dank für Deinen Einsatz.
Irgendwie mußte doch dieser Zelleninhalt zu kopieren sein.
Viele Grüße aus dem Sauerland und bis demnächst in diesem Theater ;-)
Gruß Klaus
klaus.schmitz schrieb:
Ullrich Schwarz
"Klaus Heinrich" <te...@test.de> schrieb im Newsbeitrag
news:dhugq9$197m$1...@ulysses.news.tiscali.de...
> Hallo Ullrich
>
> einfach genial, offset angepaßt, knöbsche gedrüggt und fettich ;-)
> Verstehe das coding zwar nicht, aber es läuft.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Warum eigentlich nicht? Entspricht doch fast Deinem ursprünglichen Code, nur
dass jetzt die erste Zelle [.Cells(1)] ausgewählt wird. Die Resize-Eigenschaft
ist hier übrigens eigentlich überflüssig. Es reicht also auch:
Worksheets("Rechnung").Range("F13") = _
ActiveSheet.AutoFilter.Range.Offset(1,
0).SpecialCells(xlCellTypeVisible).Cells(1).Value
Klaus Heinrich
Aha also da liegt der Hund begraben
und ich hab immer versucht das Resizing so klein zu machen,
daß nur eine Zelle übrig bleibt ;-)
Nochmals danke.