PDA

Vollständige Version anzeigen : Auswerten und kopieren


dimka2480
31.03.2012, 22:22
Hallo zusammen,

ist das erste mal das ich um eure Hilfe bitte und hoffe auf eine Lösung.

Ziel des gesuchten Makros ist es, eine Spalte nach vorgegebenen Wert abzufragen und dann bestimmte Zellen einer Zeile kopieren und in ein anderes Blatt einfügen.

Wenn eine Zahl in Spalte "J22" (also>0) steht dann die Werte folgender Spalten in "Tabellenblatt 2" kopieren: B22,F22,G22,H22,J22,K22,L22,N22,O22. Wenn in "J105" dann B105, F105, usw. Das ganze soll im "Tabellenblatt 2" ab Spalte "A7" eingefüt werden und das dann fortlaufend.

Das ganze soll über ein Button laufen. Wenn ich das nächste mal den Button drücke, sollen die alten Werte aus "Tabellenblatt 2" gelöscht werden und die neuen eingefügt.

Ich hoffe Ihr könnt mein Problem nachvollziehen und mir bei der Lösung behiflich sein.

Vielen Dank allen im Voraus!

josef e
31.03.2012, 22:39
<div style="width:85%; margin-left:5px; margin-right:15px; text-align:justify;">
Hallo ?,

<div style="background-color:#F5F5F5; border-width:2px; border-style: groove; border-color:#ff9966; padding:4px;"><nobr><span style="font-family:Courier New,Arial; font-size:8pt ;" ><b><span style="color:#0000FF"; >Sub</span> kopieren()</b><br />&nbsp;&nbsp;<span style="color:#0000FF"; >Dim</span> lngRow <span style="color:#0000FF"; >As</span> Long, lngCount <span style="color:#0000FF"; >As</span> Long, lngIndex <span style="color:#0000FF"; >As</span> <span style="color:#0000FF"; >Long</span><br />&nbsp;&nbsp;<span style="color:#0000FF"; >Dim</span> rng <span style="color:#0000FF"; >As</span> Range, vntOut() <span style="color:#0000FF"; >As</span> <span style="color:#0000FF"; >Variant</span><br />&nbsp;&nbsp;<br />&nbsp;&nbsp;Sheets(<span style="color:#808080"; >"Tabelle2"</span>).Range(<span style="color:#808080"; >"A7:I"</span> & Rows.Count) = ""<br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#0000FF"; >With</span> Sheets(<span style="color:#808080"; >"Tabelle1"</span>)<br />&nbsp;&nbsp;&nbsp;&nbsp;lngCount = Application.CountIf(.Columns(10), <span style="color:#808080"; >"&gt;0"</span>)<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >If</span> lngCount &gt; 0 <span style="color:#0000FF"; >Then</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >Redim</span> <span style="color:#0000FF"; >Preserve</span> vntOut(1 <span style="color:#0000FF"; >To</span> lngCount, 1 <span style="color:#0000FF"; >To</span> 9)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >For</span> Each rng In .Range(<span style="color:#808080"; >"J2:J"</span> & .Cells(.Rows.Count, 10).End(xlUp).Row)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >If</span> IsNumeric(rng) <span style="color:#0000FF"; >And</span> rng &gt; 0 <span style="color:#0000FF"; >Then</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;lngIndex = lngIndex + 1<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;vntOut(lngIndex, 1) = .Cells(rng.Row, 2)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;vntOut(lngIndex, 2) = .Cells(rng.Row, 6)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;vntOut(lngIndex, 3) = .Cells(rng.Row, 7)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;vntOut(lngIndex, 4) = .Cells(rng.Row, 8)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;vntOut(lngIndex, 5) = rng<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;vntOut(lngIndex, 6) = .Cells(rng.Row, 11)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;vntOut(lngIndex, 7) = .Cells(rng.Row, 12)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;vntOut(lngIndex, 8) = .Cells(rng.Row, 14)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;vntOut(lngIndex, 9) = .Cells(rng.Row, 15)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >If</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >Next</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Sheets(<span style="color:#808080"; >"Tabelle2"</span>).Range(<span style="color:#808080"; >"A7"</span>).Resize(<span style="color:#0000FF"; >UBound</span>(vntOut, 1), <span style="color:#0000FF"; >UBound</span>(vntOut, 2)) = vntOut<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >If</span><br />&nbsp;&nbsp;<span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >With</span><br /><b><span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >Sub</span></b><br /><br /></span></nobr></div>


</div>

<div style="width:100px; text-align:center; color:white; font-style:italic; font-size:0.8em; font-family:Tahoma; background-color:royalblue;margin-left:5px; margin-top:15px; padding:4px; border:3px double darkblue;">&laquo; Gru&szlig; Sepp &raquo;</div>

dimka2480
01.04.2012, 01:55
Hallo

Erstmal Vielen Dank für die Hilfe.

Ich habe das Makro ein bischen erweitert, und folgendes Problem festgestellt.

Wenn keine Werte in "J" sind, bleiben die Spalten 14, 15, 34 und 35 bestehen der Rest wird gelöscht.

Hier mein Makro:

Sub kopieren()
Dim lngRow As Long, lngCount As Long, lngIndex As Long
Dim rng As Range, vntOut() As Variant

Sheets("SB Order").Range("A7:I" & Rows.Count) = ""

With Sheets("SB")
lngCount = Application.CountIf(.Columns(10), ">0")
If lngCount > 0 Then
ReDim Preserve vntOut(1 To lngCount, 1 To 13)
For Each rng In .Range("J2:J" & .Cells(.Rows.Count, 10).End(xlUp).Row)
If IsNumeric(rng) And rng > 0 Then
lngIndex = lngIndex + 1
vntOut(lngIndex, 1) = .Cells(rng.Row, 2)
vntOut(lngIndex, 2) = .Cells(rng.Row, 4)
vntOut(lngIndex, 3) = .Cells(rng.Row, 5)
vntOut(lngIndex, 4) = .Cells(rng.Row, 6)
vntOut(lngIndex, 5) = .Cells(rng.Row, 7)
vntOut(lngIndex, 6) = .Cells(rng.Row, 8)
vntOut(lngIndex, 7) = rng
vntOut(lngIndex, 8) = .Cells(rng.Row, 11)
vntOut(lngIndex, 9) = .Cells(rng.Row, 12)
vntOut(lngIndex, 10) = .Cells(rng.Row, 14)
vntOut(lngIndex, 11) = .Cells(rng.Row, 15)
vntOut(lngIndex, 12) = .Cells(rng.Row, 35)
vntOut(lngIndex, 13) = .Cells(rng.Row, 36)
End If
Next
Sheets("SB Order").Range("A7").Resize(UBound(vntOut, 1), UBound(vntOut, 2)) = vntOut
End If
End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub


Würde mich freuen wenn ihr mir da weiterhelfen könntet.

Eine andere dumme Frage nebenbei, Wie kann man den Makronamen von "kopieren" auf "SB Order" umbenennen.

Danke im Voraus

josef e
01.04.2012, 07:04
<div style="width:85%; margin-left:5px; margin-right:15px; text-align:justify;">
Hallo ??,

das Makro kannst du nennen wie du willst, einfach "kopieren" in deinen gewünschten Namen ändern, allerdings solltest du dem Makro nicht den selben Namen geben den du schon für eine Tabelle verwendest, das kann zu Problemen führen.

Zu deinem Problem:

Ändere
<pre>Sheets("SB Order").Range("A7:I" & Rows.Count) = ""</pre>
um in
<pre>Sheets("SB Order").Range("A7:N" & Rows.Count) = ""</pre>



</div>

<div style="width:100px; text-align:center; color:white; font-style:italic; font-size:0.8em; font-family:Tahoma; background-color:royalblue;margin-left:5px; margin-top:15px; padding:4px; border:3px double darkblue;">&laquo; Gru&szlig; Sepp &raquo;</div>

dimka2480
01.04.2012, 17:19
Hallo

vielen,vielen Dank. Die Auswertung klappt super.

Jetzt wollte ich noch eine zweite Auswertung in der Tabelle haben. Habe versucht das jetzige Makro zu kopieren und ändern, leider klappt es nicht wie ich das will.

Folgendes Problem: In Spalte AQ (43) habe ich ">" "<" und "-". Wenn ich jetzt mein Button ">" drücke sollen alle in Tabelle "Micro" ab A7 eingefügt werden. Die Spalten B, D, G, H, N, O, sollen kopiert werden. Wenn der Button "<" gedrückt wird dann die ursprünglichen löschen und die neuen einfügen usw.

Kann mich nur wiederholen Danke im Voraus!

josef e
01.04.2012, 17:35
<div style="width:85%; margin-left:5px; margin-right:15px; text-align:justify;">
Hallo ?,

aus deiner Beschreibung wirst wahrscheinlich nur du klug, weil du die Hintergründe kennst.

Also bessere Beschreibung oder noch besser eine Beispieldatei.


</div>

<div style="width:100px; text-align:center; color:white; font-style:italic; font-size:0.8em; font-family:Tahoma; background-color:royalblue;margin-left:5px; margin-top:15px; padding:4px; border:3px double darkblue;">&laquo; Gru&szlig; Sepp &raquo;</div>

dimka2480
01.04.2012, 18:04
Hallo

Entschuldigung.

Also in Tabelle SB, Spalte AQ wird ein Vergleich zwischen zwei Zellen gemacht, sodass das Ergebnis "<", ">" oder "-" ist. Wenn in AQ8 "<" ist, sollen die Zellen B8, D8, G8, H8, N8, O8, und AQ8 in das Tabellenblatt "Micro" ab A7 fortlaufend kopiert werden.

Quasi wie im "kopieren Makro" nur dieses mal mit diesen Zeichen

josef e
01.04.2012, 18:25
<div style="width:85%; margin-left:5px; margin-right:15px; text-align:justify;">
Hallo ?,

<div style="background-color:#F5F5F5; border-width:2px; border-style: groove; border-color:#ff9966; padding:4px;"><nobr><span style="font-family:Courier New,Arial; font-size:8pt ;" ><span style="color:#008000"; >' **********************************************************************</span><br /><span style="color:#008000"; >' Modul: Modul2 Typ: Allgemeines Modul</span><br /><span style="color:#008000"; >' **********************************************************************</span><br /><br /><span style="color:#0000FF"; >Option</span> <span style="color:#0000FF"; >Explicit</span><br /><br /><b><span style="color:#0000FF"; >Sub</span> universal(SearchString <span style="color:#0000FF"; >As</span> <span style="color:#0000FF"; >String</span>)</b><br />&nbsp;&nbsp;<span style="color:#0000FF"; >Dim</span> lngRow <span style="color:#0000FF"; >As</span> Long, lngCount <span style="color:#0000FF"; >As</span> Long, lngIndex <span style="color:#0000FF"; >As</span> <span style="color:#0000FF"; >Long</span><br />&nbsp;&nbsp;<span style="color:#0000FF"; >Dim</span> rng <span style="color:#0000FF"; >As</span> Range, vntOut() <span style="color:#0000FF"; >As</span> <span style="color:#0000FF"; >Variant</span><br />&nbsp;&nbsp;<br />&nbsp;&nbsp;Sheets(<span style="color:#808080"; >"Micro"</span>).Range(<span style="color:#808080"; >"A7:G"</span> & Rows.Count) = ""<br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#0000FF"; >With</span> Sheets(<span style="color:#808080"; >"SB"</span>)<br />&nbsp;&nbsp;&nbsp;&nbsp;lngCount = Application.CountIf(.Columns(43), <span style="color:#808080"; >"&lt;"</span>)<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >If</span> lngCount &gt; 0 <span style="color:#0000FF"; >Then</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >Redim</span> <span style="color:#0000FF"; >Preserve</span> vntOut(1 <span style="color:#0000FF"; >To</span> lngCount, 1 <span style="color:#0000FF"; >To</span> 7)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >For</span> Each rng In .Range(<span style="color:#808080"; >"AQ2:AQ"</span> & .Cells(.Rows.Count, 43).End(xlUp).Row)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >If</span> rng = <span style="color:#808080"; >"&lt;"</span> <span style="color:#0000FF"; >Then</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;lngIndex = lngIndex + 1<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;vntOut(lngIndex, 1) = .Cells(rng.Row, 2)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;vntOut(lngIndex, 2) = .Cells(rng.Row, 4)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;vntOut(lngIndex, 3) = .Cells(rng.Row, 7)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;vntOut(lngIndex, 4) = .Cells(rng.Row, 8)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;vntOut(lngIndex, 5) = .Cells(rng.Row, 14)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;vntOut(lngIndex, 6) = .Cells(rng.Row, 15)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;vntOut(lngIndex, 7) = rng<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >If</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >Next</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Sheets(<span style="color:#808080"; >"Micro"</span>).Range(<span style="color:#808080"; >"A7"</span>).Resize(<span style="color:#0000FF"; >UBound</span>(vntOut, 1), <span style="color:#0000FF"; >UBound</span>(vntOut, 2)) = vntOut<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >If</span><br />&nbsp;&nbsp;<span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >With</span><br /><b><span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >Sub</span></b><br /><br /><br /><br /><b><span style="color:#0000FF"; >Sub</span> kleiner()</b><br />&nbsp;&nbsp;universal <span style="color:#808080"; >"&lt;"</span><br /><b><span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >Sub</span></b><br /><br /><br /><b><span style="color:#0000FF"; >Sub</span> groesser()</b><br />&nbsp;&nbsp;universal <span style="color:#808080"; >"&gt;"</span><br /><b><span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >Sub</span></b><br /><br /><br /><b><span style="color:#0000FF"; >Sub</span> egal()</b><br />&nbsp;&nbsp;universal <span style="color:#808080"; >"-"</span><br /><b><span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >Sub</span></b><br /><br /></span></nobr></div>


</div>

<div style="width:100px; text-align:center; color:white; font-style:italic; font-size:0.8em; font-family:Tahoma; background-color:royalblue;margin-left:5px; margin-top:15px; padding:4px; border:3px double darkblue;">&laquo; Gru&szlig; Sepp &raquo;</div>

dimka2480
01.04.2012, 21:49
Hallo

Leider klappt das ganze nicht. Liegt wahrscheinlich an meiner Beschreibung.

Hätte am liebsten eine Datei hochgeladen, geht aber irgendwie nicht.

Hier mein Visual Basic inhalt vom Tabellenblatt SB


Sub kopierenSBOrder()
Dim lngRow As Long, lngCount As Long, lngIndex As Long
Dim rng As Range, vntOut() As Variant

Sheets("SB Order").Range("A8:N" & Rows.Count) = ""

With Sheets("SB")
lngCount = Application.CountIf(.Columns(10), ">0")
If lngCount > 0 Then
ReDim Preserve vntOut(1 To lngCount, 1 To 13)
For Each rng In .Range("J2:J" & .Cells(.Rows.Count, 10).End(xlUp).Row)
If IsNumeric(rng) And rng > 0 Then
lngIndex = lngIndex + 1
vntOut(lngIndex, 1) = .Cells(rng.Row, 2)
vntOut(lngIndex, 2) = .Cells(rng.Row, 4)
vntOut(lngIndex, 3) = .Cells(rng.Row, 5)
vntOut(lngIndex, 4) = .Cells(rng.Row, 6)
vntOut(lngIndex, 5) = .Cells(rng.Row, 7)
vntOut(lngIndex, 6) = .Cells(rng.Row, 8)
vntOut(lngIndex, 7) = rng
vntOut(lngIndex, 8) = .Cells(rng.Row, 11)
vntOut(lngIndex, 9) = .Cells(rng.Row, 12)
vntOut(lngIndex, 10) = .Cells(rng.Row, 14)
vntOut(lngIndex, 11) = .Cells(rng.Row, 15)
vntOut(lngIndex, 12) = .Cells(rng.Row, 35)
vntOut(lngIndex, 13) = .Cells(rng.Row, 36)
End If
Next
Sheets("SB Order").Range("A8").Resize(UBound(vntOut, 1), UBound(vntOut, 2)) = vntOut
End If
End With
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub


' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub universal(SearchString As String)
Dim lngRow As Long, lngCount As Long, lngIndex As Long
Dim rng As Range, vntOut() As Variant

Sheets("Micro").Range("A7:G" & Rows.Count) = ""

With Sheets("SB")
lngCount = Application.CountIf(.Columns(43), "<")
If lngCount > 0 Then
ReDim Preserve vntOut(1 To lngCount, 1 To 7)
For Each rng In .Range("AQ2:AQ" & .Cells(.Rows.Count, 43).End(xlUp).Row)
If rng = "<" Then
lngIndex = lngIndex + 1
vntOut(lngIndex, 1) = .Cells(rng.Row, 2)
vntOut(lngIndex, 2) = .Cells(rng.Row, 4)
vntOut(lngIndex, 3) = .Cells(rng.Row, 7)
vntOut(lngIndex, 4) = .Cells(rng.Row, 8)
vntOut(lngIndex, 5) = .Cells(rng.Row, 14)
vntOut(lngIndex, 6) = .Cells(rng.Row, 15)
vntOut(lngIndex, 7) = rng
End If
Next
Sheets("Micro").Range("A7").Resize(UBound(vntOut, 1), UBound(vntOut, 2)) = vntOut
End If
End With
End Sub



Sub kleiner()
universal "<"
End Sub


Sub groesser()
universal ">"
End Sub


Sub egal()
universal "-"
End Sub


Der erste Teil mit dem Kopieren klappt wunderbar aber das kopieren mit grösser und kleiner geht garnicht.

Bin Ratlos was ich falsch mache.

josef e
01.04.2012, 21:53
<div style="width:85%; margin-left:5px; margin-right:15px; text-align:justify;">
Hallo ?,

gehe auf <button>Erweitert</button> und dann auf <Button>Anhänge verwalten</button>


</div>

<div style="width:100px; text-align:center; color:white; font-style:italic; font-size:0.8em; font-family:Tahoma; background-color:royalblue;margin-left:5px; margin-top:15px; padding:4px; border:3px double darkblue;">&laquo; Gru&szlig; Sepp &raquo;</div>

dimka2480
01.04.2012, 22:03
Hallo hier die Datei

josef e
01.04.2012, 22:28
<div style="width:85%; margin-left:5px; margin-right:15px; text-align:justify;">
Hallo Dietrich,

mit den richtigen Infos ist's gleich leichter.


</div>

<div style="width:100px; text-align:center; color:white; font-style:italic; font-size:0.8em; font-family:Tahoma; background-color:royalblue;margin-left:5px; margin-top:15px; padding:4px; border:3px double darkblue;">&laquo; Gru&szlig; Sepp &raquo;</div>

dimka2480
01.04.2012, 22:44
Vielen Dank!