Microsoft Excel

Herbers Excel/VBA-Archiv

Makro für Kreditlimits | Herbers Excel-Forum


Betrifft: Makro für Kreditlimits von: TUE
Geschrieben am: 05.01.2012 09:08:12

Guten Morgen,

zunächst möchte ich Euch allen ein frohes und gesundes Jahr 2012 wünschen.
Ich beschäftige mich gerade mit der Einrichtung einer neuen Tabelle für Kreditlimits
und möchte gerne, dass diese einfach und komfortabel über ein Makro gefüllt wird.

Leider komme ich nicht weiter.

Im Anhang eine Tabelle, die grob verdeutlicht was ich machen möchte.

A2 bis A6 sind die Vorgaben, die in der B-Spalte verfüllt werden.

Jetzt soll Excel abhängig von dem Feld „B2“ (Code) prüfen, welcher Code eingegeben wurde,
und dann unter dem letzten Code-Feld in der eingerahmten Tabelle eine leere Zeile einfügen
und die Werte der Felder B3 bis B6 in diese Zeile übernehmen.

Wer kann mir hier mit ein bisschen Code helfen?

Vielen Dank!

LG
TUE

https://www.herber.de/bbs/user/78221.xlsx

  

Betrifft: VBA: Eingaben in Tabelle passend einsortieren von: NoNet
Geschrieben am: 05.01.2012 11:13:59

Hallo Tobias,

anbei eine VBA-Lösung - beim Öffnen der Mappe müssen Makros aktiviert werden (evtl. in den Sicherheitseinstellungen ändern !!).

https://www.herber.de/bbs/user/78224.xlsm

Das Makro übertragt die Eingaben an die passende Position der Tabelle, sobald die Eingaben vollständig sind - daher wird nach jedem Eingabesatz auch der Eingabebereich sofort gelöscht !

Die Beschreibung enthielt wohl einen kleinen Fehler : Die Eingabe "Limits" in B4 sollte wohl in Spalte C ("Höhe") der Tabelle übertragen werden und nicht in die Formelspalte G ("Limits") oder ?

Gruß, NoNet


  

Betrifft: AW: VBA: Eingaben in Tabelle passend einsortieren von: TUE
Geschrieben am: 05.01.2012 16:10:09

Hallo und vielen Dank für den guten Ansatz!



Das ist genau das was ich brauche.



Ich habe jetzt noch eine Spalte B eingefügt, die abhängig vom Code in Spalte A eine entsprechende Aufschlüsselung in einen Kurztext vornehmen soll. Das würde ich dann über ein extra Datenblatt machen.



Mein Problem ist, dass ich nicht weiß, wo ich den VBA-Code ändern muss, damit die Daten weiterhin



in den richtigen Spalten landen.







Außerdem werden die Formeln, die die Werte in den Spalten G und H errechnen beim Anlegen der neuen Zeilen nicht übernommen , sondern Excel schreibt dort „Saldo“ und „Limit“ rein (siehe Anhang).



Wie können diese Probleme im Code gelöst werden?







Über erneute Hilfestellung würde ich mich sehr freuen.







MfG







https://www.herber.de/bbs/user/78229.xlsm


  

Betrifft: Eingaben in Tabelle passend einsortieren - II von: NoNet
Geschrieben am: 06.01.2012 02:52:53

Hallo Tobias,

ich habe das Makro bereits sehr variabel auf Deinen ursprünglichen Tabellenaufbau hin erstellt.
Wenn Du den Aufbau der Tabelle nun nachträglich änderst, sind natürlich Anpassungen nötig.
Die erste Änderung (Eingabebereich) hast Du ja bereits durchgeführt - genau deshalb habe ich das Makro auch recht variabel gehalten. Die zweite notwendige Änderung hättest Du auch entdecken können (da im Code kommentiert !) :

Deine Ausgabetabelle beginnt nun in Zeile 9 und nicht mehr in Zeile 8, daher folgende Codezeile :

lngT = 9 'Startzeile der Ausgabetabelle
Hier der gesamte Code (letzte Änderung siehe *** SCHNIPP ****SCHNAPP **** :
Private Sub Worksheet_Change(ByVal Target As Range)
    'Exit Sub 'Falls Makro nicht ausgeführt werden soll
    
    Dim lngZ As Long, rngEingaben As Range, lngT As Long
    
    Set rngEingaben = [B3:B7] 'Definition Eingabenbereich
    lngT = 9 'Startzeile der Ausgabetabelle
    
    'Falls Eingaben in B3:B7 vollständig
    If Not Intersect(Target, rngEingaben) Is Nothing And _
        Application.CountA(rngEingaben) = rngEingaben.Count Then
        
        lngZ = Cells(Rows.Count, 1).End(xlUp).Row 'letzte belegte Zeile der Tabelle ermitteln
        If Application.CountIf(Range("A" & lngT + 1 & ":A" & lngZ), rngEingaben.Cells(1, 1)) =  _
0 Then
            lngZ = Cells(Rows.Count, 1).End(xlUp).Row + 1 'nächste freie Zeile unterhalb  _
Tabelle
        Else
            If Cells(lngZ, 1) = rngEingaben.Cells(1, 1) Then
                lngZ = lngZ + 1
            Else
                lngZ = lngT + Application.Match(rngEingaben.Cells(1, 1) + 1, _
                    Range("A" & lngT + 1 & ":A" & lngZ), 0)
            End If
        End If
            
        Rows(lngT + 1).Copy
        Rows(lngZ).Insert Shift:=xlDown
        
        '********* Ab hier wurde geändert : ******* SCHNIPP *******
        Cells(lngZ, 1) = rngEingaben.Cells(1, 1)    'Code übertragen
        rngEingaben.Offset(1).Resize(rngEingaben.Count - 1).Copy 'Eingaben o. CODE kopieren
        'Eingaben ohne CODE transponiert ab Spalte 3 einfügen :
        Cells(lngZ, 3).PasteSpecial Paste:=xlValues, Transpose:=True
        '********* Bis hier wurde geändert : ****** SCHNAPP *******
        
        rngEingaben.ClearContents                   'Eingaben löschen
        
        rngEingaben.Cells(1, 1).Select              'Erste Eingabezelle aktivieren
        Application.CutCopyMode = False
    End If
End Sub

Gruß, NoNet


  

Betrifft: AW: Eingaben in Tabelle passend einsortieren - II von: TUE
Geschrieben am: 06.01.2012 07:29:45

Guten Morgen,

danke für den guten Tipp. Habe Ihn gestern noch umgesetzt und bin jetzt auf ein - hoffentlich letztes - Problem gestoßen.

Ich füge z.B. zweimal den Code 670002 ein. Klappt prima.
Danach habe ich einmal 670024 eingefügt.

Wenn ich jetzt versuche noch einmal den 670002 einzufügen erhalte ich die folgende Fehlermeldung:

Laufzeitfehler 13: Typen unverträglich
lngZ = lngT + Application.Match(rngEingaben.Cells(1, 1) + 1, _
Range("A" & lngT + 1 & ":A" & lngZ), 0)

Könnte das evtl. an der SVERWEIS-Funktion in der B-Spalte liegen?

Über Deine Hilfe freue ich mich sehr.

Vielen Dank!

LG
Tobias

https://www.herber.de/bbs/user/78244.xlsm


  

Betrifft: AW: Eingaben in Tabelle passend einsortieren - II von: TUE
Geschrieben am: 09.01.2012 08:01:47

Guten Morgen,

kann mir eventuell jemand bei der o.g. Fehlermeldung in meiner Tabelle helfen?

Ich würde mich sehr über Tipps freuen.

Vielen Dank!

LG
TUE