Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1024to1028
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
Inhaltsverzeichnis

Einer Range Werte aus anderen Sheets zuweisen

Einer Range Werte aus anderen Sheets zuweisen
13.11.2008 16:39:00
adrian
Hallo,
folgendes funktioniert nicht....weißt nicht wie ich es sonst lösen könnte!
Über jegliche Hilfe + Erklärung würde ich mich sehr freuen =)
will einem Bereich in einem Sheet einfach nur bestimmte werte aus anderen sheets einfügen.
schon mal eingefügte Werte sollen nicht nochmal eingefügt werden!
hier mal der code:
ich denke das fettgedruckte ist mein kleines problem...
lg
adrian

Private Sub Worksheet_Activate()
Dim ODMZ As Integer, i As Integer
ODMZ = Worksheets("Philips (A)").Range("SupplierAs").Cells.Count
ODMZ = ODMZ + Worksheets("Philips (EU)").Range("SupplierEU").Cells.Count
ODMZ = ODMZ + Worksheets("Philips (US)").Range("SupplierUS").Cells.Count
ReDim tempVar(0 To ODMZ, 0)
i = 0
With Range("ODMList")
For Each Cell In Worksheets("Philips (A)").Range("SupplierAs")
If Cell  "" Then
If IsNumeric(Application.Match(Cell, tempVar, 0)) = False Then
tempVar(i, 0) = Cell.Value
.AddItem Cell.Value
i = i + 1
End If
End If
Next
For Each Cell In Worksheets("Philips (EU)").Range("SupplierEU")
If Cell  "" Then
If IsNumeric(Application.Match(Cell, tempVar, 0)) = False Then
tempVar(i, 0) = Cell.Value
.AddItem Cell.Value
i = i + 1
End If
End If
Next
For Each Cell In Worksheets("Philips (US)").Range("SupplierUS")
If Cell  "" Then
If IsNumeric(Application.Match(Cell, tempVar, 0)) = False Then
tempVar(i, 0) = Cell.Value
.AddItem Cell.Value
i = i + 1
End If
End If
Next
End With
End Sub


11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Einer Range Werte aus anderen Sheets zuweisen
13.11.2008 18:20:00
Uduuh
Hallo,
einen benannten Bereich kannst du nicht mit AddItem erweitern oder etwas hinzufügen.
Gruß aus’m Pott
Udo

AW: Einer Range Werte aus anderen Sheets zuweisen
13.11.2008 19:09:00
fcs
Hallo Adrian,
bei Bereichen funktioniert AddItem nicht. Hier kann man mit "Find" prüfen, ob ein Zellinhalt schon vorkommt. Ich hab deine Prozedur mal entsprechend angepasst.
Gruß
Franz

Option Explicit
Private rngListe As Range, rngZiel As Range
Private Sub Worksheet_Activate()
Dim strName As String
strName = "ODMList" 'Bereichsname der Werte aufnehmen soll
Set rngListe = Nothing
'######## Befehle, wenn vorhandene Werte gelöscht werden sollen #######
Application.Range(strName).ClearContents
'1. Zelle der Liste setzen
Set rngZiel = Application.Range(strName).Range("A1")
'######### Befehle, wenn vorhandene Werte nicht gelöscht werden sollen ####
'Set rngListe = Application.Range(strName)
'letzte Zelle innerhalb der Liste setzen
'Set rngZiel = rngListe.Range("A1").Offset(rngListe.Rows.Count - 1, 0)
Call Bereich_Auslesen(rngBereich:=Worksheets("Philips (A)").Range("SupplierAs"))
Call Bereich_Auslesen(rngBereich:=Worksheets("Philips (EU)").Range("SupplierEU"))
Call Bereich_Auslesen(rngBereich:=Worksheets("Philips (US)").Range("SupplierUS"))
With rngListe
'Liste Sortieren
.Sort Key1:=.Range("A1"), Order1:=xlAscending, header:=xlNo
'Listenbereich dem Namen neu zuweisen
Application.Names(strName).RefersTo = "='" & .Parent.Name & "'!" & .Address
End With
End Sub
Private Sub Bereich_Auslesen(rngBereich As Range)
Dim rngGefunden As Range
Dim Zelle As Range
For Each Zelle In rngBereich
If Zelle  "" Then
If rngListe Is Nothing Then
rngZiel = Zelle.Value
Set rngListe = rngZiel
Else
With rngListe
Set rngGefunden = .Find(What:=Zelle.Value, LookIn:=xlValues, lookat:=xlWhole)
If rngGefunden Is Nothing Then
Set rngZiel = rngZiel.Offset(1, 0)
rngZiel.Value = Zelle.Value
Set rngListe = Union(rngListe, rngZiel)
End If
End With
End If
End If
Next
End Sub


Anzeige
AW: Einer Range Werte aus anderen Sheets zuweisen
14.11.2008 16:35:00
adrian
Hi Franz,
das Ding ist echt genial! für mich zumindest =)
hab es auch verstanden, denke ich!
Zu meinem Verständnis, wo ich mir nicht so ganz sicher bin...:
If rngListe Is Nothing Then
rngZiel = Zelle.Value
Set rngListe = rngZiel

diese IF-Anweisung ist nur für den ersten Wert des Bereichs.
Danach wird sie nicht mehr durchlaufen, da "rngListe" nur Anfangs kein Wert "Nothing" hat und bereits beim nächsten Wert des Bereichs alle zuvorigen gespeichert hat.
Die Liste füllt sich quasi mit "Set rngListe = Union(rngListe, rngZiel)" dem gerade laufenden Wert "rngZiel" sofern "If rngGefunden Is Nothing Then" erfüllt ist.
"rngListe" ist ein array mit den gespeicherten Werten und "rngZiel" die nächste speicherzelle im array "strName" das durch den Bereich "ODMList" definiert ist.
der Rest des Syntax ist soweit logisch, soweit mein Kommentar hier stimmt.
wäre super, wenn ich von dir diesbezüglich nochmal feedback bekomme =)
vielen dank & lg
adrian
Anzeige
AW: Einer Range Werte aus anderen Sheets zuweisen
14.11.2008 17:54:21
fcs
Hallo Adrian,
den Ablauf des Makros hast du soweit verstanden.
Zum Verständnis:
rngListe ist kein Array sondern eine Objektvariablen die einen Zellbereich im Tabellenblatt repräsentiert.
Wenn du im Code einen Haltepunkt setzt und dann das Makro im Schrittmodus ausführts kannst du bei verkleinertem VBA-Editorfenster verfolgen, wie die Liste in der Tabelle mit Daten gefüllt wird.
Die Methoden "Find" und "Union" funktionieren nur mit Zellbereichen einer Tabelle.
"rngZiel" ist nicht die nächste Speicherzelle im array "strName" das durch den Bereich "ODMList" definiert ist. "rngZiel" wird am Beginn des Makros auf die Startzelle (A1) des Bereichs von Name "ODMList" gesetzt. Danach wandert rngZiel "einfach" nach jeder neuen Fundstelle um eine Zelle nach unten und wird per "Union" mit rngListe zum jeweils neuen Listenbereich verbunden.
Erst ganz zum Schluss wird Name "ODMList" der neue durch rngListe repräsentierte Zellbereich zugewiesen.
Gruß
Franz
Anzeige
AW: Einer Range Werte aus anderen Sheets zuweisen
18.11.2008 12:49:00
adrian
Hallo Franz,
da du mir ja schon echt viel geholfen hast und deine Ideen mir echt gefallen, wende ich mich hiermit mal zuerst an dich =)
Mit dem folgenden Syntax bekomme ich Werte für die in den Zellen R, S und T70 angezeigten Supplier aus den angegeben Bereichen der drei Sheets.
Die Zellen R, S, T70 usw. werden bereits schon, dank deiner Hilfe, mit Supplieren aus den drei Sheets gefülllt und bei Hinzufügen eines neuen ergänzt.
Quasi werden diese Sheets nach den (hier noch drei) Supplieren durchsucht und ihre zugehörigen Werte an das Hauptsheet in die angegeben Zellen übermittelt.
Wenn ich jetzt in einem der 3 Sheets einen Supplier hinzufüge muss ich diese Prozedur für diesen im Syntax erweitern.
Wie könnte ich es möglich machen, dass ich diesen Syntax nicht mehr schreiben muss, bzw. die Werte füt den Supplier automatisch in den nächsten Zellen ermittelt werden?
In den Sheets stehen die Werte immer rechts neben dem zugehörigen Supplier.
Gerne sende ich dir auch den Syntax, falls du ihn brauchst!
Bin für jede Hilfe sehr dankbar =)
lg adrian
'TPV data locator
range("R71").Clear
range("R72").Clear
range("R73").Clear
For Each Cell In Worksheets("Philips (A)").range("SupplierAs")
If Cell = range("R70") Then
range("R71").Value = Cell.Offset(0, -1).Value
End If
Next
For Each Cell In Worksheets("Philips (EU)").range("SupplierEU")
If Cell = range("R70") Then
range("R72").Value = Cell.Offset(0, -1).Value
End If
Next
For Each Cell In Worksheets("Philips (US)").range("SupplierUS")
If Cell = range("R70") Then
range("R73").Value = Cell.Offset(0, -1).Value
End If
Next
'TCL data locator
range("S71").Clear
range("S72").Clear
range("S73").Clear
For Each Cell In Worksheets("Philips (A)").range("SupplierAs")
If Cell = range("S70") Then
range("S71").Value = Cell.Offset(0, -1).Value
End If
Next
For Each Cell In Worksheets("Philips (EU)").range("SupplierEU")
If Cell = range("S70") Then
range("S72").Value = Cell.Offset(0, -1).Value
End If
Next
For Each Cell In Worksheets("Philips (US)").range("SupplierUS")
If Cell = range("S70") Then
range("S73").Value = Cell.Offset(0, -1).Value
End If
Next
' Funai data locator
range("T71").Clear
range("T72").Clear
range("T73").Clear
For Each Cell In Worksheets("Philips (A)").range("SupplierAs")
If Cell = range("T70") Then
range("T71").Value = Cell.Offset(0, -1).Value
End If
Next
For Each Cell In Worksheets("Philips (EU)").range("SupplierEU")
If Cell = range("T70") Then
range("T72").Value = Cell.Offset(0, -1).Value
End If
Next
For Each Cell In Worksheets("Philips (US)").range("SupplierUS")
If Cell = range("T70") Then
range("T73").Value = Cell.Offset(0, -1).Value
End If
Next
Anzeige
AW: Einer Range Werte aus anderen Sheets zuweisen
18.11.2008 18:01:00
fcs
Hallo Adrian,
auch hier kann man die Suppliernamen in der Zeile 70 sehr schon mit einer Schleife abarbeiten.
Die 1. Spalte gibts du im Code vor, die letzte Spalte imt einem Eintrag ermittelt das Makro.
Mit der Suchen-Funktion (ist schneller als deine Suche per For-next-Schleife) wird der Supplier in den 3 Blättern gesucht und der Wert rechts von der gefundenen zelle ausgelesen und im Blatt eingetragen.
Blattname und Startspalte muss du im Code anpassen.
Gruß
Franz

Sub DatenHolenZeile70()
Dim wksData As Worksheet, rngGefunden As Range, lngSpalte As Long
Dim lngZeile As Long, lngSpalteL As Long, varSupplier
lngZeile = 70 'Zeile mit den Suppliernamen im Hauptdatenblatt
Const lngSpalte1 As Long = 4 'Spalte D erste Spalte in Zeile 70 mit Suppliername
Set wksData = Worksheets("Hauptdata")
With wksData
'Letzte Spalte mit supplier in Zeile 70 ermitteln
lngSpalteL = .Cells(lngZeile, .Columns.Count).End(xlToLeft).Column
'Spalten mit Suppliernamen abarbeiten
For lngSpalte = lngSpalte1 To lngSpalteL
'3. Zellen unterhalb Suppliername: Inhalte löschen
.Range(.Cells(lngZeile + 1, lngSpalte), .Cells(lngZeile + 3, lngSpalte)).ClearContents
'Suppliername für Suche merken
varSupplier = .Cells(lngZeile, lngSpalte).Value
'Supplier in den 3 Blättern im benamten bereich suchen
'Wert aus Spalte rechts von gefundener Zelle in Zeile 71 eintragen
Call SubSuchen(rngBereich:=Worksheets("Philips (A)").Range("SupplierAs"), _
varSuchen:=varSupplier, wks:=wksData, Zeile:=lngZeile + 1, Spalte:=lngSpalte)
'Wert aus Spalte rechts von gefundener Zelle in Zeile 72 eintragen
Call SubSuchen(rngBereich:=Worksheets("Philips (EU)").Range("SupplierEU"), _
varSuchen:=varSupplier, wks:=wksData, Zeile:=lngZeile + 2, Spalte:=lngSpalte)
'Wert aus Spalte rechts von gefundener Zelle in Zeile 73 eintragen
Call SubSuchen(rngBereich:=Worksheets("Philips (US)").Range("SupplierUS"), _
varSuchen:=varSupplier, wks:=wksData, Zeile:=lngZeile + 3, Spalte:=lngSpalte)
Next
End With
End Sub
Sub SubSuchen(rngBereich, varSuchen, wks, Zeile, Spalte)
Dim rngGefunden As Range
'Supplier im benamten bereich suchen
Set rngGefunden = rngBereich.Find(what:=varSuchen, LookIn:=xlValues, lookat:=xlWhole)
If Not rngGefunden Is Nothing Then
'Wert aus Spalte rechts von gefundener Zelle in Zielzelle eintragen
wks.Cells(Zeile, Spalte).Value = rngGefunden.Offset(0, 1).Value
End If
End Sub


Anzeige
AW: Einer Range Werte aus anderen Sheets zuweisen
19.11.2008 11:26:21
adrian
Hallo Franz,
also ich muss schon sagen, du bist genial =)
ist sogar so toll geschrieben, dass ich es auch verstehe!
vielen, vielen Dank!!
vll. magst du mir noch kurz erklären wie du hiermit die Letze Spalte findest:
SpalteL = .Cells(Zeile, .Columns.count).End(xlToLeft).Column
lg
adrian
AW: Einer Range Werte aus anderen Sheets zuweisen
19.11.2008 13:21:00
fcs
Hallo Adrian,
Diese Zeile muss du in Verbindung mit der zugehörigen With - Zeile lesen

With wksData 'Objektvariable für ein Tabellenblatt
SpalteL = .Cells(Zeile, .Columns.Count).End(xlToLeft).Column
End With


Der "." vor Cells und Columns bedeutet, dass sich diese Objekte auf das in der With-Zeile angegebene Tabellenblatt beziehen.
.Columns.Count = Anzahl der Spalten des Tabellenblatts
.Cells(Zeile, .Columns.Count) = Letzte Zelle in der Zeile des Tabellenblatts
.End(xlToLeft) = weist Excel an von der angegebenen Zelle nach links die 1. nicht leere Zelle zu suchen. (entspricht der Tasten-Kombination Strg+PfeilLinks bei Zellansteuerung per Tastatur im Tabellenblatt)
.Column weist Excel an, die Spalte der gefundenen Zelle als Ergebnis zurückzugeben.
In gleicher Weise kann man mit


With Worksheets("Tabelle1")
ZeileL = .Cells(.Rows.Count, Spalte).End(xlUp).Row
End With

die letzte Zelle in einer Spalte ermitteln die nicht leer ist.
Gruß
Franz

Anzeige
AW: Einer Range Werte aus anderen Sheets zuweisen
19.11.2008 15:11:00
adrian
Hi,
Super, Super...hab verstanden =)
hab das schon mit der "with" Zeile gelesen, nur war mir ".end(xlToLeft).column"
einfach nicht so klar.
Jetzt aber...eigentlich sehr logisch =)
Danke dir!!
lg
adrian
AW: Einer Range Werte aus anderen Sheets zuweisen
21.11.2008 14:32:00
adrian
Hi Franz, kannst du mir sagen warum das nicht Funktioniert?
Will einfach das die zuvor eingetragenen Werte aus den Zellen wieder gelöscht werden, falls ich einen Supplier lösche!
lg
adrian
With Datenblatt
Set SpalteR = .range(.Cells(Zeile + 1, SpalteL + 1), .Cells(Zeile + 5, SpalteL + 1))
While Found Is Not Nothing
Set Found = SpalteR.Find(what:=Cells.Value, LookIn:=xlValues, Lookat:=xlWhole)
If Not Found Is Nothing Then
SpalteR.ClearContents
Set SpalteR = SpalteR.Offset(0, 1)
End If
End With
Anzeige
AW: Einer Range Werte aus anderen Sheets zuweisen
21.11.2008 14:47:00
adrian
Sry, das ict echt Unsinn,
eher so:
Set SpalteR = .range(.Cells(Zeile + 1, SpalteL + 1), .Cells(Zeile + 5, SpalteL + 1))
Set Found = SpalteR.Find(what:=Cells.Value, LookIn:=xlValues, Lookat:=xlWhole)
While Found Is Not Nothing
Set Found = SpalteR.Find(what:=Cells.Value, LookIn:=xlValues, Lookat:=xlWhole)
If Not Found Is Nothing Then
SpalteR.ClearContents
Set SpalteR = SpalteR.Offset(0, 1)
End If
Wend
lg
adrian

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige