Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
532to536
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
532to536
532to536
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

@Sepp und VBA-Könner: Makro anpassen

@Sepp und VBA-Könner: Makro anpassen
20.12.2004 11:57:35
Fritz
Hallo VBA-Profis,
Sepp Ehrensberger hat mir gestern nachfolgenden Code geschrieben, der seine Aufgabe hervorragend erledigt. Ich habe nun aber eine ähnliche Aufgabenstellung, wozu der Code angepasst werden muss.
Dazu brauche ich aber erneut eure Hilfe.
Die Quelle ist wieder die Tabelle "Daten" (identisch mit vorheriger Aufgabe).
Unterschiede: Zieltabelle ist nun die Tabelle "Daten2", die ebenfalls ab Zeile 5 "gefüllt" werden sollte. Der Unterschied zur früheren Aufgabenstellung stelle ich wie folgt dar:
1. es sollen die Datensätze übertragen werden, bei denen die "x" in einer der
Spalten K bis AD stehen und zwar jeweils der Spalte, bei der der Wert in
der Zeile 4 dem Wert der Zelle L3 entspricht, also ist der Wert in M4
identisch mit dem Wert von L3 sollen die Datensätze ausgewählt werden, die
im Bereich M5:M421 mit einem "x" versehen sind.
2. Die Datenfelder der Spalten B,C und D und G der Quelltabelle "Daten" sollen
in die gleichen Spalten der Zieltabelle eingetragen werden, die Daten aus
der Spalte E (Quelltabelle) sollten in die Spalte F (Zieltabelle)
geschrieben werden.
3. Vor dem Kopieren sollte in der Zieltabelle jeweils nur der Bereich B5:D421
und G5:F421 gelöscht werden.
Vielen Dank für die Hilfe.
Gruß
Fritz
Hier der bisherige Code:
Sub Daten_Uebertragen() Dim quelle As Worksheet Dim ziel As Worksheet Dim rng As Range Dim lRow As Long Dim lastRow As Long Set quelle = Sheets("Daten") Set ziel = Sheets("Daten1") With Application .ScreenUpdating = False .EnableEvents = False .DisplayAlerts = False .Calculation = xlCalculationManual End With lastRow = 5 ziel.Range(" B5:G421").ClearContents With quelle For lRow = 5 To 421 If LCase(.Cells(lRow, 10)) = "x" Then Set rng = Union(.Cells(lRow, 2), .Cells(lRow, 3), .Cells(lRow, 5), _ .Cells(lRow, 7), .Cells(lRow, 8), .Cells(lRow, 9)) rng.Copy ziel.Cells(lastRow, 2).PasteSpecial xlPasteValues lastRow = lastRow + 1 End If Next End With With Application .CutCopyMode = False .ScreenUpdating = True .EnableEvents = True .DisplayAlerts = True .Calculation = xlCalculationAutomatic End With End Sub

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: @Sepp und VBA-Könner: Makro anpassen
20.12.2004 12:22:59
Josef
Hallo Fritz!
Ungetestet:

Sub Daten_Uebertragen2()
Dim quelle As Worksheet
Dim ziel As Worksheet
Dim rFind As Range
Dim iCol As Integer
Dim lRow As Long
Dim lastRow As Long
Set quelle = Sheets("Daten")
Set ziel = Sheets("Daten2")
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
lastRow = 5
Set rFind = quelle.Range("A4:IV4").Find(quelle.[L3])
If Not rFind Is Nothing Then
iCol = rFind.Column
ziel.Range("B5:D421,F5:G421").ClearContents
With quelle
For lRow = 5 To 421
If LCase(.Cells(lRow, iCol)) = "x" Then
ziel.Range(ziel.Cells(lastRow, 2), ziel.Cells(lastRow, 4)).Value = _
.Range(.Cells(lRow, 2), .Cells(lRow, 4)).Value
ziel.Cells(lastRow, 6) = .Cells(lRow, 5)
ziel.Cells(lastRow, 7) = .Cells(lRow, 7)
lastRow = lastRow + 1
End If
Next
End With
Else
MsgBox "Keine Übereinstimmung!"
End If
With Application
.CutCopyMode = False
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Zu deiner Frage bezüglich Blattschutz:
Schreib diesen Code in ein allgemeines Modul und lass ihn laufen,
dann ist das Blatt geschützt, du kannst aber über VBA darauf zugreifen.

Sub BlattSchutz()
Worksheets("Daten1").Protect password:="deinPW", userinterfaceonly:=True
'UserInterfaceOnly=True schützt das Blatt vor Bearbeitung, lässt aber
'den Zugriff durch VBA zu!
End Sub

Gruß Sepp
Anzeige
Off Topic: @ Fritz
20.12.2004 13:16:33
Josef
Hallo Fritz!
Sebastian sagt Danke für den "Weazel"!
Auch von mir ein herzliches Danke und wir wünschen Dir und
Deiner Familie ein schönes und geruhsames Weihnachtsfest!
Gruß Sepp
AW: Off Topic: @ Fritz
Fritz
Hallo Sepp,
danke für die guten Weihnachtswünsche.
Der "Weazel" kann nicht annähernd das ausgleichen, was mir deine Unterstützung in den letzten Tagen genützt hat.
Inzwischen habe ich mich so intensiv mit dem Testen des abgeänderten Codes beschäftigt, dass mir mittlerweile der Kopf brummt. Das Makro lieferte in zwei fast identischen Fällen - zunächst für mich nicht nachvollziehbare - unterschiedliche "Ergebnisse". Während in einem Fall die Sache wie gewünscht funktionierte, wurde im anderen Falle beim Aufruf die Zieltabelle ggf. gelöscht, aber nicht beschrieben. Nach intensivem Nachforschen bin ich der Sache wohl auf den Grund gekommen: Im dem zweiten Beispiel hatte ich die Werte in L3 und K4:AD4 über eine Formel ermittelt. Zwischen einzelnen dieser Zellen bestand dabei eine Beziehung.
In einem anderen Fall habe ich die Formel in L3 gelöscht und in L4 folgende Formel eingeben: Wenn(istzahl(k4);k4+1;""). Diese Formel habe ich dann in den Bereich M4:AD4 kopiert. In diesem Fall kam dann die Meldung "Keine Übereinstimmung". Offensichtlich ist in VBA das was in einer Zelle angezeigt wird nicht immer dasselbe, zumindest wenn der Wert über eine Formel ermittelt wird.
Ich habe nun halt die Tabellen so umgestaltet, dass die Sache funktioniert. Möchte Dich jetzt mit der Sache nicht mehr bemühen, ich kann mit der jetzigen Lösung auch leben.
Den Rat hinsichtlich des Blattschutzes versuche ich noch umzusetzen, melde mich ggf. noch einmal.
Noch einmal besten Dank!
Frohe Weihnachten
und zusätzliche Grüße an Sebastian
Fritz
Anzeige
spezieller Blattschutz
Fritz
Hallo Sepp,
gerade habe ich das mit dem Makro "BlattSchutz" angewandt. Funktioniert soweit. Ich hatte beim bisherigen Blattschutz jedoch die folgenden Möglichkeit aktiviert (erlaubt):
gesperrte Zellen auswählen
nicht gesperrte Zellen auswählen
Sortieren
AutoFilter verwenden
Sortieren und Filtern funktioniert nun nicht mehr. Gibt es bei einem
"VBA"-Blattschutz auch die Möglichkeit, Sortieren und Filtern zuzulassen?
Wenn ja, wie funktioniert das?
Gruß
Fritz
AW: spezieller Blattschutz
20.12.2004 16:28:06
Josef
Hallo Fritz!
Sortieren kannst du nur, wenn du den Blattschutz vorher aufhebst!
Filtern geht, aber der Filter muss schon vor dem Schützen gesetzt sein
und der Code muss so lauten:
(schreib den Code in "DieseArbeitsmappe" weil "UserInterfaceOnly" im neu gesetzt werden muss!)

Private Sub Workbook_Open()
With Worksheets("Daten1")
.Protect password:="PW", userinterfaceonly:=True
.EnableAutoFilter = True
End With
End Sub

Gruß Sepp
Anzeige
AW: spezieller Blattschutz
Fritz
Hallo Sepp,
wenn die Filtermöglichkeit gegeben ist, reicht mir das auch.
Noch einen Wunsch habe ich hinsichtlich des letzten Makros. Wie erreiche ich, dass die jeweilige Zahl aus L3 (Quelltabelle "Daten") immer auch in der Zieltabelle (Daten2) in die Zelle C2 geschrieben wird? Diese Zelle (C2) muss somit (möglicherweise) auch bei jedem Makroaufruf zunächst wieder gelöscht werden.
Ich denke (hoffe!), das wars dann (für heute).
Gruß
Fritz
Die letzte Frage? Denkste!
Fritz
Hallo Sepp,
schon wieder ein Problem. Blattschutz über "DieseArbeitsmappe" eingerichtet.
Starte ich jetzt das Makro "Übertragen2" werden zwar die entsprechenden Daten in der Zieltabelle "Daten2" gelöscht, die neueen Daten aber nicht wieder hineinkopiert.
Hat das was mit dem Blattschutz zu tun?
Gruß
Fritz
Anzeige
AW: Die letzte Frage? Denkste!
20.12.2004 18:06:35
Josef
Hallo Fritz!
Du musst natürlich auch für "Daten2" den Schutz per VBA setzen!
Hier das makro mit Eintragung "L3" in "C2"

Sub Daten_Uebertragen2()
Dim quelle As Worksheet
Dim ziel As Worksheet
Dim rFind As Range
Dim iCol As Integer
Dim lRow As Long
Dim lastRow As Long
Set quelle = Sheets("Daten")
Set ziel = Sheets("Daten2")
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
lastRow = 5
Set rFind = quelle.Range("A4:IV4").Find(quelle.[L3])
If Not rFind Is Nothing Then
iCol = rFind.Column
ziel.Range("C2,B5:D421,F5:G421").ClearContents
ziel.[C2].Value = quelle.[L3].Value
With quelle
For lRow = 5 To 421
If LCase(.Cells(lRow, iCol)) = "x" Then
ziel.Range(ziel.Cells(lastRow, 2), ziel.Cells(lastRow, 4)).Value = _
.Range(.Cells(lRow, 2), .Cells(lRow, 4)).Value
ziel.Cells(lastRow, 6) = .Cells(lRow, 5)
ziel.Cells(lastRow, 7) = .Cells(lRow, 7)
lastRow = lastRow + 1
End If
Next
End With
Else
MsgBox "Keine Übereinstimmung!"
End If
With Application
.CutCopyMode = False
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Gruß Sepp
Anzeige
AW: Die letzte Frage? Denkste!
Fritz
Hallo Sepp,
ich danke Dir. Was ich noch alles lernen sollte!
Gruß
Fritz
Rätselhaft!
Fritz
Hallo Sepp!
Bei der Anwendung des Makros "Uebertragen2" tauchen immer noch (für mich) rätselhafte Ergebnisse auf. Ich weiss nicht, woher das kommt.
Vorweg: Ich hatte zwischenzeitlich den Blattschutz gesetzt, dann nachdem das Makro - wie nachfolgend beschrieben - z.T. nicht die gewünschten Ergebnisse lieferte wieder deaktiviert. Das hat aber nichts geändert, es sei denn dieser spezielle Blattschutz "wirkt nach"?
Jetzt zu den Ungereimtheiten:
Das Makro schreibt jedesmal (!) korrekt den richtigen Wert aus Daten L3 nach Daten2 C2. Das Makro habe ich mit den Zahlen 1 bis 15 (in L3)getetest und diese Zahlen hatte ich dabei abwechselnd in unterschiedliche Spalten (K4:Ad4) geschrieben.
Dabei wurden die vorgesehenen Zellen in der Zieltabelle Daten2 immer gelsöcht!Beschrieben wurde die Zieltabelle jedoch nicht bei den Werten 1, 5 und 11 (jedoch bei 15). Es macht offensichtlich keinen Unterschied, in welcher Spalte die jeweilige Zahl stand (im Bereich K4:AD4) , d.h. stand in K4 der Wert 2 und in L3 auch, funktionierte das ganze, stand in K4 jedoch die 1, 5 oder 11 funktionierte das Makro nur insoweit, dass die Zahl korrekt in C2 (Daten2) geschrieben wurde und die Zieltabelle auch "gereinigt" wurde, jedoch nicht mit den Datensätzen beschrieben.
Soweit meine Testergebnisse.
Kannst Du Dir aus diesen Informationen einen Reim machen.
Gruß
Fritz
Anzeige
AW: Rätselhaft!
21.12.2004 16:37:04
Josef
Hallo Fritz!
Ich hab' jetzt bei mir herumgetestet, konnte das Verhalten aber
nicht nachvollziehen!
Kannst du die Mappe mit den beiden Tabellen hochladen?
Gruß Sepp
AW: Rätselhaft! - Ursache ermittelt!
Fritz
Hallo Sepp,
ich habe zwischenzeitlich weiter getestet und gesucht und habe nach (über 1 Stunde) doch noch die Ursache gefunden. Hat sich letztlich (doch) gelohnt.
Ein Profi wie Du es bist, hätte die Ursache allerdings sofort erkannt.
Was war nun die Ursache?
In der Tabelle "Daten" hatte ich die Spalte (I) ausgeblendet. In dieser Spalte habe ich in einigen Zellen "Nebenrechnungen" untergebracht. So war z.B. die Zelle I4(!) mit einer Formel belegt, in der Bezug genommen auf die Zellen I5 und I11 genommen wurde.
Das war der Grund! Ich habe die Formel aus I4 einfach in eine andere (freie) Zelle in einer anderen Zeile (der Spalte I) "verschoben". Plötzlich funktionierte alles!!
Nochmals danke für deine Unterstützung.
Gruß
Fritz
P.S. Werde gleich noch eine andere Frage (Aufgabe) ins Forum stellen
Anzeige
gut gemacht ;-)) o.T.
21.12.2004 17:47:13
Josef
Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige