emotionmedia
Aug 04, 2008, updated at Aug 27, 2008 (UTC)
view8094
view8
0
Goto Top

Wert in variable Spalte und Zeile übernehmen

GermansolvedQuestionMicrosoft OfficeMicrosoft
Hallo Zusammen

Ich muss wegen der hohen Komplexität eines Excel-Files, eine Eingabemaske erstellen. Darin wird der jeweilige Tag des Monats und die betreffende Position eingetragen bzw. ausgewählt.
Zusätzlich wird in einem Feld ein Nummerischer Wert eingetragen, welcher in ein bestimmtes Tabellenblatt übernommen werden soll.

Dieses Formular sieht also ungfähr so aus:

Tag: <13>
Position: <Guggus>
Wert: <3.5>

Die Tabelle in die der Wert (in diesem Falle 3.5) übernommen werden muss, sieht so aus:

Positionen | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 etc....bis max. 31

Nun soll das VBA Makro ausfindig machen auf welcher Zeile (anhand der Position) und in welcher Spalte (anhand des Tages) der Wert übernommen werden muss und tragt ihn dort ein.

Kann mir da jemand helfen?

Besten Dank schon im Voraus & Grüsse aus der Schweiz!
Andy
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 93528

Url: https://administrator.de/contentid/93528

Printed on: April 19, 2024 at 18:04 o'clock

8 Comments
Latest comment
Goto Top
Member: bastla
bastla Aug 04, 2008 at 13:02:47 (UTC)
Goto Top
Hallo emotionmedia und willkommen im Forum!

Etwa so:
Sub Eintrag()
Tag = 13
Position = "Guggus"  
Wert = 3.5

Basis = "A3" 'erste Zelle der Überschrift  

Zeile = Range(Basis).Row + 1
Spalte = Range(Basis).Column

Suchwert = Trim(LCase(Position))
Z = 0
Do While Cells(Zeile, Spalte).Value <> ""  
    If Trim(LCase(Cells(Zeile, Spalte).Value)) = Suchwert Then
        Z = Zeile
        Exit Do
    End If
    Zeile = Zeile + 1
Loop
If Z = 0 Then
    MsgBox Position & " nicht gefunden!", vbCritical  
Else
    Cells(Z, Spalte + Tag).Value = Wert
End If
End Sub
Deine Variablen habe ich, zu Testzwecken, in den ersten Zeilen festgelegt. Die Variable "Basis" enthält die Adresse der linken oberen Ecke Deiner Matrix (= erste Zelle der Überschriftszeile, Inhalt = "Positionen")

Gesucht wird in der Spalte "Positionen" so lange, bis die Zelle mit dem Inhalt der Variablen "Position" (ohne Berücksichtigung von Groß-/Kleinschreibung und ev am Anfang oder Ende enthaltenen Leerzeichen) oder eine leere Zelle gefunden wird.

Grüße
bastla
Member: emotionmedia
emotionmedia Aug 05, 2008 at 13:24:27 (UTC)
Goto Top
Hallo Bastla

Vielen Dank schonmal für Deine super Aufstellung. Versuche das nun gerade zu adaptieren.
Nun habe ich noch eine ganz blöde Frage dazu:

Ich möchte z.B. die Variable Position setzen. Dazu mache ich grundsätzlich:

Position = Range("B4").Value

Doch nun ist es so, dass das Eingabeformular auf einer Tabelle ist und die die Variable "Wert" auf eine andere hin transportiert werden muss. Demnach gehe ich davon aus, dass ich ja noch irgendwie die speziefischen Blätter ansprechen muss. Damit das Script weiss von welchem Blatt die Zelle B4 zu nehmen ist.

Wie mache ich das noch?

Grüsse,
emotionmedia
Member: bastla
bastla Aug 05, 2008 at 13:29:48 (UTC)
Goto Top
Hallo emotionmedia!

Um "Tabelle1" anzusprechen, wäre die Schreibweise:
Position = Worksheets("Tabelle1").Range("B4").Value
Grüße
bastla
Member: emotionmedia
emotionmedia Aug 26, 2008 at 07:13:35 (UTC)
Goto Top
Hallo Bastla!
Ich habe nun intensiv versucht das Script lauffähig zu bringen. Leider bisher ohne Erfolg. Der Mitarbeiter resp. seine MA-Nummer wird in der Tabelle nicht gefunden.
Mein Script sieht nun folgendermassen aus:

[CODE]
Public Sub EingabeUbernehmen()
' Makro am 04.08.2008 von ARE geschrieben
' Version 0.1
'
' Definition der benötigten Variabeln
Dim Spalte As String
' Prüfen ob Pflichtfelder ausgefüllt sind
' Wenn B2 == 1 = gut
If (Range("B2").Value = 1) Then
' Übernahme in "Hausm"-Tabelle
If (Range("B6").Value <> "") Then
Entry "test"
End If
Range("C20").Value = "Daten von " & Range("C4").Value & " übernommen"
Else ' Wenn Pflichtfelder nicht vollständig
Range("C20").Value = "Pflichtfelder nicht vollständig"
End If
End Sub

Private Sub Entry(Arbeitsblatt As String)
Basis = "A5" 'erste Zelle der Überschrift

Tag = Worksheets("EINGABEMASKE").Range("B3").Value
Position = Worksheets("EINGABEMASKE").Range("B4").Value
Wert = Worksheets("EINGABEMASKE").Range("B6").Value

Zeile = Worksheets(Arbeitsblatt).Range(Basis).Row + 1
Spalte = Worksheets(Arbeitsblatt).Range(Basis).Column
Suchwert = Trim(LCase(Position))
Z = 0
Do While Cells(Zeile, Spalte).Value <> ""
If Trim(LCase(Cells(Zeile, Spalte).Value)) = Suchwert Then
Z = Zeile
Exit Do
End If
Zeile = Zeile + 1
Loop
If Z = 0 Then
MsgBox "Mitarbeiter Nr. " & Position & " nicht gefunden!", vbCritical
Else
Cells(Z, Spalte + Tag).Value = Wert
End If
End Sub
[/CODE]

Es kommt immer die vbCritical-Meldung "Mitarbeiter Nr. 9 nicht gefunden", obwohl die Nr. 9 in der Tabelle "test" vorhanden ist...

Gruss schon im Voraus für jede Hilfe...
Andy
Member: bastla
bastla Aug 26, 2008 at 12:22:20 (UTC)
Goto Top
Hallo emotionmedia!

Wenn Du "ferngesteuert" arbeitest, musst Du natürlich auch die Tabelle, in welche der Eintrag erfolgen soll, angeben:
Private Sub Entry(Arbeitsblatt As String)
Basis = "A5" 'erste Zelle der Überschrift  

Tag = Worksheets("EINGABEMASKE").Range("B3").Value  
Position = Worksheets("EINGABEMASKE").Range("B4").Value  
Wert = Worksheets("EINGABEMASKE").Range("B6").Value  

Zeile = Worksheets(Arbeitsblatt).Range(Basis).Row + 1
Spalte = Worksheets(Arbeitsblatt).Range(Basis).Column
Suchwert = Trim(LCase(Position))

With Worksheets(Arbeitsblatt)
    Z = 0
    Do While .Cells(Zeile, Spalte).Value <> ""  
        If Trim(LCase(.Cells(Zeile, Spalte).Value)) = Suchwert Then
            Z = Zeile
            Exit Do
        End If
        Zeile = Zeile + 1
    Loop
    If Z = 0 Then
        MsgBox "Mitarbeiter Nr. " & Position & " nicht gefunden!", vbCritical  
    Else
        .Cells(Z, Spalte + Tag).Value = Wert
    End If
End With
End Sub
Grüße
bastla

P.S.: Hier brauchst Du für die Formatierung als "Code" Tags mit "<" und ">" anstelle der eckigen Klammern.
Member: emotionmedia
emotionmedia Aug 27, 2008 at 07:55:37 (UTC)
Goto Top
Hallo bastla

Leider funktioniert's noch immer nicht. Aus irgendeinem Grund bleibt der Wert Z ständig bei 0 (durchsucht die Zeilen nicht...). Der Einfachheit halber habe ich mal mein File unter folgender Adresse hinauf geladen:

http://public.me.com/emotainment

Gruss,
emotionmedia
Member: bastla
bastla Aug 27, 2008 at 08:20:11 (UTC)
Goto Top
Hallo emotionmedia!

Die funktionierende Version zu Deiner Testdatei würde so aussehen:
Private Sub Entry(Arbeitsblatt As String)
    Basis = "A1" 'erste Zelle der Überschrift  

    Tag = Worksheets("EINGABEMASKE").Range("B3").Value  
    Position = Worksheets("EINGABEMASKE").Range("B4").Value  
    Wert = Worksheets("EINGABEMASKE").Range("B6").Value  

   Zeile = Worksheets(Arbeitsblatt).Range(Basis).Row + 1
' Zeile = 1  
    Spalte = Worksheets(Arbeitsblatt).Range(Basis).Column
    Suchwert = Trim(LCase(Position))
    
    With Worksheets(Arbeitsblatt)
        Z = 0
        Do While .Cells(Zeile, Spalte).Value <> ""  
            If Trim(LCase(.Cells(Zeile, Spalte).Value)) = Suchwert Then
                Z = Zeile
                Exit Do
            End If
            Zeile = Zeile + 1
        Loop
        If Z = 0 Then
            MsgBox "Mitarbeiter Nr. " & Position & " nicht gefunden!", vbCritical  
        Else
            .Cells(Z, Spalte + Tag).Value = Wert
        End If
    End With
MsgBox "DEBUG: Tag:" & Tag & ", Position:" & Position & ", Wert:" & Wert & ", Zeile:" & Zeile & ", Spalte:" & Spalte & ", Suchwert:" & Suchwert & ", Arbeitsblatt:" & Arbeitsblatt  
End Sub
Zum Einen hast Du zum Testen die Variable "Basis" nicht angepasst, sondern die (Start-)Zeile konstant eingegeben - allerdings mit Wert 1, womit (da A1 leer ist) die Suche sofort beendet wurde, zum Anderen hast Du zuwenig Punkte gemacht (jeweils vor "Cells") ...

Grüße
bastla
Member: emotionmedia
emotionmedia Aug 27, 2008 at 09:29:02 (UTC)
Goto Top
Wow, nun funktioniert's perfekt!!
Vielen herzlichen Dank für Deine super Hilfe - Du bist ja ein wahrer VB-Crack!!

Lieben Gruss aus der Schweiz!!
Andy aka emotionmedia
GermansolvedQuestionMicrosoft OfficeMicrosoft
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 3 CommentsAlexWishaHow to set up and configure a Linux GRE tunnelAlexWisha - 3 CommentsjstrickerWIREGUARD VPN ON UDM PRO BEHIND FRITZBOX - HANDSHAKE DID NOT COMPLETEjstricker - 3 CommentsDaniEnd of Support dates for Office 2016, 2019 Apps und Productivity ServersDani - 1 Comment