25.08.2010

4725

Wert nach Zelleninhaltkriterium von Tabellenblatt übernehmen

Hallo!

Also, es gibt 2 Tabellenblätter: Kalender und XYZ

Im TB "XYZ" gibt es eine Liste (C5), bei der die Auswahl eines Monats möglich ist.
Wenn nun zB das Monat Juni gewählt wird, sollen nun im Bereich B15:B53 TB "XYZ" die Werte vom TB "Kalender", Spalte (K) (Wert: K14="Juni"), B15:B53 übernommen werden.

Das heißt, ich müsste die Monatsauswahl von C5 im TB (Kalender), in der Zeile 14 suchen und dann die darunterliegenden Werte im Bereich gesuchteSpalte15:gesuchteSpalte53 auf das TB(XYZ) B15:B53 übertragen.

Naja, leider übsteigt die realisierung ein bisschen meine Fähigkeiten (in VBA).
Würde mich freuen, wenns da eine kleine Unterstützung gäbe, um diese Überlegung in die Realität umzusetzen.

Lg Mike

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 149662

Url: https://administrator.de/forum/wert-nach-zelleninhaltkriterium-von-tabellenblatt-uebernehmen-149662.html

Ausgedruckt am: 24.12.2024 um 03:12 Uhr

32 Kommentare

Neuester Kommentar

Hallo Mike!

Sollte in etwa so gehen:

Private Sub Test()
    Call CopyMonthRange("Juni")  
End Sub

Private Sub CopyMonthRange(ByRef M)
    Dim Monat As Range
    
    With Sheets("Kalender")  
        Set Monat = .Rows(14).Find(M, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
    End With
    
    If Not Monat Is Nothing Then
        Range(Monat.Offset(1, 0), Monat.Offset(39, 0)).Copy Sheets("XYZ").Range("B15")  
    End If
End Sub

Gruß Dieter

Aja, okey!

Und wenn ich jetzt zB sage:

Call CopyMonthRange("Range("C5").Value")  

dann übernimmt er den Wert, der eben gerade in C5 steht, da ja dort verschiedene Werte stehen können (Auswahl über Dropdown-Liste).

Lg Mike

Hallo Mike!

Deswegen das Testbeispiel. Wie Du die Variable übergibst ist wurscht, solange es sich beim übergebenen Inhalt um verwertbare Values handelt

Allerdings dann:

Call CopyMonthRange(Range("C5").Value)

wobei eigentlich

Call CopyMonthRange(Range("C5"))

ausreichend ist, da Value generell als Standard festgelegt ist.

Gruß Dieter

Hm...jetzt funktioniert zwar ansich der Code, aber es wird nichts kopiert...!

Kann es damit zusammenhängen, das die Tabellenblätter geschützt sind?

verwende eben jetzt diesen Code:

Private Sub CopyMonthRange(ByRef M)
    Dim Monat As Range
    
    With Sheets("Kalender")  
        Set Monat = .Rows(15).Find(M, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
    End With
    
    If Not Monat Is Nothing Then
        Range(Monat.Offset(1, 0), Monat.Offset(5, 0)).Copy Worksheets(Tabelle1).Range("B15")  
    End If
End Sub

Hallo Mike!

Zitat von @xaumichi:

Hm...jetzt funktioniert zwar ansich der Code, aber es wird nichts kopiert...!

Ich dachte die Monatsnamen befinden sich in Zeile 14 und die Zeilen 15-53 sollen kopiert werden?

Kann es damit zusammenhängen, das die Tabellenblätter geschützt sind?

Wenn Tabelle1 geschützt ist, dann funktioniert es nicht

Sollte auch eine Debugger-Fehlermeldung erscheinen?

Füge mal Testweise in Codezeile 3 das hier ein:

MsgBox M

Test ob überhaupt ein Monat übergeben wird?

Gruß Dieter

Hallo!
Aja, hab die Zeile wieder auf 14 geändert, war mein fehler.
Hab das mit dem MsgBox M ausprobiert --> Monat wird richtig ausgelesen.

Tabelle1 ist nicht gesperrt.

Bekomm diesen Fehler:

Laufzeitfehler: Typen unverträglich

[EDIT]:
Ah...hab bei Worksheets(Tabelle1) die "" vergessen.
Jetzt kommt allerdings dieser Fehler:

Die Methode 'Range' für das Objekt '_Worksheet' ist fehlgeschlagen

Lg Mike

Zitat von @xaumichi:
Ah...hab bei Worksheets(Tabelle1) die "" vergessen.

Ups, das habe ich doch glatt auch übersehen

Jetzt kommt allerdings dieser Fehler:
Die Methode 'Range' für das Objekt '_Worksheet' ist fehlgeschlagen

Mhm, da habe ich jetzt aber keine Erklärung für

Könntest mal das ausprobieren:

Range(Monat.Offset(1, 0), Monat.Offset(5, 0)).Copy Destination:=Sheets("Tabelle1").Range("B15")   

bzw., wie sah diese Zeile jetzt bei Dir aus?

Gruß Dieter

Hm....hätte ich selber schon probiert...kommt leider der selbe fehler....!

das war meine

Range(Monat.Offset(1, 0), Monat.Offset(5, 0)).Copy Sheets("Tabelle1").Range("B15")  

LG Mike

Hallo Mike!

Kann leider keinen Fehler entdecken, poste nochmal die komplette Sub

Gruß Dieter

Private Sub CopyMonthRange(ByRef M)
    Dim Monat As Range
    
    With Sheets("Kalender")  
        Set Monat = .Rows(14).Find(M, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
    End With
    
    If Not Monat Is Nothing Then
        Range(Monat.Offset(1, 0), Monat.Offset(5, 0)).Copy Sheets("Tabelle1").Range("B15")  
    End If
End Sub

und

Call CopyMonthRange(Range("C5").Value)  

(wenn ich beim 2. code das ".Value" weg tue, kommt der selbe Fehler.)

Lg Mike

Hallo Mike!

Versuchs mal damit:

Private Sub CopyMonthRange(ByRef M)
    Dim Monat As Range
    
    With Sheets("Kalender")  
        Set Monat = .Rows(14).Find(M, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
    
        If Not Monat Is Nothing Then
            Range(.Cells(Monat.Row + 1, Monat.Column), .Cells(Monat.Row + 5, Monat.Column)).Copy Sheets("Tabelle1").Range("B15")  
        End If
    End With
End Sub

oder damit:

Private Sub CopyMonthRange(ByRef M)
    Dim Monat As Range
    
    With Sheets("Kalender")  
        Set Monat = .Rows(14).Find(M, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
    
        If Not Monat Is Nothing Then
            With .Columns(Monat.Column)
                Range(.Rows(Monat.Row + 1), .Rows(Monat.Row + 5)).Copy Sheets("Tabelle1").Range("B15")  
            End With
        End If
    End With
End Sub

Gruß Dieter

Hm...beide Versionen führen zu dem selben, oben genannten Fehler...!

Lg mike

Hallo nochmal!

Wenn das auch nicht funktioniert, dann versuch das:

Private Sub CopyMonthRange(ByVal M As String)
    Dim Monat As Range
    
    If M = "" Then Exit Sub  
    
    With Sheets("Kalender")  
        Set Monat = .Rows(14).Find(M, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
    End With
    
    If Not Monat Is Nothing Then
        Range(Monat.Offset(1, 0), Monat.Offset(39, 0)).Copy Sheets("Tabelle1").Range("B15")  
    End If
End Sub

um sicher zu gehen, das auch nur Strings mit Inhalt gesucht werden.

Gruß Dieter

PS. Dachte ich mir, dass die vorherigen Versionen auch nicht funktionieren, insofern der Test auf Leerstring

Auch damit konnte ich keinen Erfolg erziehlen.
Bekomme noch immer den selben Fehler.

Könnte es sein, dass Excel (aus welchem Grund auch immer) nicht kopieren kann??

LG Mike

Hallo Mike!

Tja, was soll ich sagen

Bei mir funktioniert es einwandfrei und der Code ist soweit auch korrekt?

Ich habe leider keine Ahnung, was bei Dir dazwischen funken könnte. eventuell eine Erreignis-Verarbeitung???

Hast Du's schon mit einer einfachen Mappe ohne weiteren VBA-Code versucht, in der nur das Tabellenblatt "Kalender" geschützt ist und in der Zelle K14 den Monat Juni und darunter 1,2,3,4.... eingibst und dann mit einer Test-Sub einfach die Copy-Sub mit "Juni", so wie bei meiner allerersten Anwort, aufrufst?

Gruß Dieter

Tja, das ganze ist bei mir in einer Change-Ereignis hinein gepackt....! :S

So, dann werd ich das mal so testen...!

Danke vorerst mal!

Lg Mike

Hallo Mike!

Da war doch noch die Sache mit dem NoChange = True/False, dass musst Du hier auch anwenden

Gruß Dieter

Jup, das wäre dabeuí. Also es befindet sich in der selben If-Schleife.

Hm...mir ist jetzt noch was aufgefallen:
Ist es möglich, dass etwas mit dem 2. Offset nicht hinhaut?
den beim 1. Offset bekomm ich eine gelbe Infobox, wenn ich mit Maus darauf zeige, beim 2. Offset kommt nichts.

LG Mike

Zitat von @xaumichi:
Hm...mir ist jetzt noch was aufgefallen:
Ist es möglich, dass etwas mit dem 2. Offset nicht hinhaut?
den beim 1. Offset bekomm ich eine gelbe Infobox, wenn ich mit Maus darauf zeige, beim 2. Offset kommt nichts.

Was meinst Du jetzt, die Sache mit der Validation.ShowInput-Geschichte? Wenn ja, dann habe ich aus dem Stehgreif auch keine Antwort darauf

Gruß Dieter

Nein, nein, bei dem Programm jetzt:
Ich bekomm ja den oben genannten Fehler.
Wenn ich dann auf "Debuggen" gehen, wird die fehlerhafte Zeile gelb hinterlegt.

das wäre dann die:

Range(Monat.Offset(1, 0), Monat.Offset(39, 0)).Copy Sheets("Tabelle1").Range("B15")  

und wenn ich nun den Cursor auf Monat.Offset(1, 0) stelle, kommt eine Gelbe Box, die mir den Wert dieses Ranges anzeigt.
Beim Monat.Offset(39, 0) wird mir dagegen nichts angezeigt....

Lg Mike

Hallo Mike!

Ja, steht denn in Zeile 53 auch was drinnen?

Und hats mit einer normalen Mappe funktioniert?

Gruß Dieter

Hallo!

Jup, in Zeile 53 stehen ebenfalls Werte.
Hm...hab mich jetzt mit einer "leeren" Arbeitsmappe gespielt, hab es allerdings auch dort nicht zum laufen bebkommen.

Lg Mike

Hallo Mike!

Da fehlen mir echt die Worte:'(, was hast denn für eine Sch... Excel-Version

Mach mal testweise vor die besagte Zeile ein Kommentarzeichen und schreib mal hin:

Sheets("Kalender").Range("K14:K53").Copy Sheets("Tabelle1").Range("B15")

ob denn das weningstens funktioniert

Gruß Dieter

PS. Eine Frage habe ich aber noch und zwar, ob in den zu kopierenden Zellen nur Werte oder Formeln drin stehen?

Also in den Zellen, AUS denen kopiert wird, stehen nur Werte.
Die Zellen IN die EINGEFÜGT wird bestehen Verbindungen zu VBA-Code.

LG Mike

Hallo Mike!

Und hast Du das mit dem .....Range("K15:K53").Copy getestet?

Und/oder setze mal vor das Sheets ein Kommentarzeichen, um zu sehen, ob der Copy-Befehl funktioniert bzw einen Debuggerfehler erzeugt

Range(Monat.Offset(1, 0), Monat.Offset(39, 0)).Copy 'Sheets("Tabelle1").Range("B15")

Gruß Dieter

Hallo!

Nein, bekomm den selben Fehler, wenn ich ein ' setze!

Lg Mike

Hallo Mike!

Test mal das hier

Private Sub CopyMonthRange(ByVal M As String)
    Dim Monat As Range, B As String, E As String, R As String
    
    If M = "" Then Exit Sub  
    
    With Sheets("Kalender")  
        Set Monat = .Rows(14).Find(M, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
    End With
    
    If Not Monat Is Nothing Then
        B = Monat.Offset(1, 0).Address
        E = Monat.Offset(39, 0).Address
        R = Range(Monat.Offset(1, 0), Monat.Offset(39, 0)).Address
        
        MsgBox "Begin = " & B & ", End = " & E & ", Range = " & R  
        
       'Range(Monat.Offset(1, 0), Monat.Offset(39, 0)).Copy Sheets("Tabelle1").Range("B15")  
    End If
End Sub

und schau was die MsgBox anzeigt?

Gruß Dieter

Hui, heute bist du aber schon bald unterwegs!

Ich bekomme bei:

R = Range(Monat.Offset(1, 0), Monat.Offset(39, 0)).Address

wieder diesen Fehler, dass 'Range' vom Objekt '_Worksheets' nicht übertützt wird!

wenn ich diesen per ' übergehe, dann bekomme ich die Ausgabe.

Hab jetzt

Range(B, E).Copy Sheets("Tabelle1").Range("B15")

versucht:
Jetzt funktioniert zwar das Kopieren, allerdings kopiert er mir nun die Werte nicht vom TB "Kalender" sondern von dem TB, wo die "Monatswahl" stattfindet!

LG Mike

Zitat von @xaumichi:
Ich bekomme bei:

R = Range(Monat.Offset(1, 0), Monat.Offset(39, 0)).Address

wieder diesen Fehler, dass 'Range' vom Objekt '_Worksheets' nicht übertützt wird!

Seltsam, seltsam?

Hab jetzt

 Range(B, E).Copy Sheets("Tabelle1").Range("B15")

versucht:
Jetzt funktioniert zwar das Kopieren, allerdings kopiert er mir nun die Werte nicht vom TB "Kalender" sondern von dem
TB, wo die "Monatswahl" stattfindet!

Ja, das kann natürlich nicht funktionieren, da jetzt das gerade Aktive Sheet als Quelle genommen wird

Dann sollte eigentlich das jetzt funktionieren:

Private Sub CopyMonthRange(ByVal M As String)
    Dim Monat As Range, B As String, E As String, R As String
    
    If M = "" Then Exit Sub  
    
    With Sheets("Kalender")  
        Set Monat = .Rows(14).Find(M, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
    
        If Not Monat Is Nothing Then
            .Range(Monat.Offset(1, 0), Monat.Offset(39, 0)).Copy Sheets("Tabelle1").Range("B15")  
        End If
    End With
End Sub

Gruß Dieter

Das kappier ich nicht!
Das ist doch der selbe Code wie oben, außerdem werden B, E und R niergends verwendet, obwohl du sie definierst...oder überseh ich da was?
Wobei er funktioniert!

Toll, danke schön!

Jetzt hätte ich vl noch eine kleine Frage:
Kann man ein Ereignis auslösen, wenn der eingefügt Wert ein " " (als nichts) ist?
Das Problem ist ja das Einfügen von kopierten Werten...! (es geht um das Sperren und Grau hinterlegen, wenn "nichts" eingefügt wird)

Lg Mike

Hallo Mike!

Zitat von @xaumichi:

Das kappier ich nicht!
Das ist doch der selbe Code wie oben, außerdem werden B, E und R niergends verwendet, obwohl du sie definierst...oder
überseh ich da was?

Ja, wenn Du mal etwas genauer hinsiehst, dann wird Dir eventuell auffallen, dass sich die Copyzeile jetzt innerhalb der With-Anweisung befindet und das Range noch einen Punkt bekommen hat

Gruß Dieter