Range.Validation - Ich erhalte immer den selben Fehler beim ausführen des folgenden Codes. Wer kann Helfen?

 with Range("K2").validation
      .Delete
      .add xlValidateList, AlertStyle:=xlValidAlertStop, _ 
      Operator:=xlBetween, Formula1:="=BEREICH.VERSCHIEBEN _
       (kunde1;0;0;ANZAHL2(kunde1)-ZAEHLENWENN(kunde1;0))"
end with

Wäre sehr dankbar für Hilfen.

Mit freundlichen Grüßen

Matze

2 Antworten

Vom Beitragsersteller als hilfreich ausgezeichnet

verreisterNutzer

28.10.2018, 11:40

Einen "selben Fehler" kenn ich nicht

MatzeDGF

Beitragsersteller

28.10.2018, 14:35

Laufzeitfehler '1004':

Anwendungs- oder objektdefinierter Fehler

Oubyi, UserMod Light

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel

28.10.2018, 11:49

Ich denke, Du brauchst die englische Formel.
Teste mal:

 With Range("K2").Validation
   .Delete
   .Add xlValidateList, AlertStyle:=xlValidAlertStop, _
   Operator:=xlBetween, Formula1:="=OFFSET(kunde1,0,0,COUNTA(kunde1)-COUNTIF(kunde1,0))"
End With

Woher ich das weiß:Berufserfahrung – IT-Administrator (i.R.)

MatzeDGF

Beitragsersteller

28.10.2018, 14:36

Funktioniert leider auch nicht

Ähnliche Beiträge

Excel VBA Datenüberprüfung beim Einfügen (Strg+V) von Text in Zelle aufrecht erhalten?

Hallo zusammen,

ich greife gerade im Rahmen eines Projekts per Datenüberprüfung auf eine Auswahl von 6000+ Zellen zu und möchte falls ein Teil, das nicht zu den 6000 gehört eine Fehlermeldung ausgeben. Nun habe ich die Problematik, dass die Zelle mit der Datenüberprüfung eine Eingabezelle sein wird, d. h. der Benutzer wird Werte aus anderen XML Dokumenten hereinkopieren. Dies Formatiert die Zelle aber Standardmäßig um und entfernt die eingerichtete Datenüberprüfung.

Gibt es hier eine einfache Lösung dies zu verhindern? Ich habe es auch schon mit Excel VBA versucht (s. Quelltext) aber hier konnte ich nur die Datenüberprüfung nachdem sie entfernt wurde wieder hinzufügen. Das Problem hierbei ist, dass dem User keine Fehlermeldung angezeigt wird nachdem er den Text in die Zelle kopiert hat.

Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Address = "$A$2" Then

With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertWarning, Operator _
        :=xlBetween, Formula1:="='Zuord. Teil-Kart. Datenquelle '!$A$1:$A$6168"
        .IgnoreBlank = True
        .InCellDropdown = False
        .InputTitle = ""
        .ErrorTitle = "Teil nicht verfügbar"
        .InputMessage = ""
        .ErrorMessage = _
        "Teil nicht verfügbar, da:" & Chr(10) & "a) Teil existiert nicht" & Chr(10) & "b) Teil existiert, wird aber nicht in Kartonage verpackt --> Manuelle Frachtberechnung nötig" & Chr(10) & "c) Teil ist neu --> Rückmeldung an *** / ***"
        .ShowInput = True
        .ShowError = True
    End With
End If

...zum Beitrag

Exel VBA Problem. Erwartet Anweisungsende?

Hi,

ich möchte mithilfe einer VBA Schaltfläche eine Formel in eine Zelle schreiben, bekomme aber mal den Fehler: erwartet Anweisungsende und mal einen Syntaxfehler

With ThisWorkbook.Worksheets("Tabelle1").Activate

Range("K20").Value = "=WENN(B25="4:3";E10/0,8;WENN(B25="16:9";E10/0,87;"Fehler"))"

End With

End Sub

...zum Beitrag

VBA Dateiauswahl - Bei Abbruch Laufzeitfehler 5, jemand Ideen?

Hallo zusammen,

was müsste ich hinzufügen, um den Laufzeitfehler 5 zu umgehen? Wenn ich den VBA-Code ausführe, öffnet sich das Fenster für den Import von DAT-Dateien. Drücke ich auf Abbrechen, erscheint der Laufzeitfehler 5. Vermerkt wird der Code "Set F = fs.GetFolder(strPfad)". Wo und welchen Code müsste ich hinzufügen, um den Fehler zu beheben? Vielen Dank im Voraus. :)

Sub Schaltfläche1_Klicken()
'
'
'*** Öffnen von DAT-Dateien
Dim strText As String, strFilter As String

strText = "Bitte eine Auswertung Auswählen"
strFilter = "DAT-Dateien (*.DAT), *.DAT"""
strAuswahl = Application.GetOpenFilename(strFilter, 1, strText)
strPfad = Pfad_ermitteln(strAuswahl)
'
Set fs = CreateObject("Scripting.FileSystemObject")
Set F = fs.GetFolder(strPfad)
Set fc = F.Files

If ActiveSheet Is Nothing Then Workbooks.Add
For Each File In fc
    Zeile = Cells(65000, 1).End(xlUp).Row + 2
    strEinfügen = Cells(Zeile, 1).Address
    strAuswahl = File.Path

    'Einfügen
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & strAuswahl _
        , Destination:=Range(strEinfügen))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileDecimalSeparator = "."
        .TextFileThousandsSeparator = ","
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
  End With
  Range(strEinfügen).QueryTable.Delete
Next
End Sub
_______________________________

 Function Pfad_ermitteln(ByVal strAuswahl As String) As String
 
 For i = Len(strAuswahl) To 1 Step -1
    If Mid(strAuswahl, i, 1) = "\" Then
        Pfad_ermitteln = Left(strAuswahl, i - 1)
        Exit Function
    End If
Next
End Function

...zum Beitrag

Kann ich RGB Farben statt Indexfarben nutzen?

Ich habe eine Exceltabelle in der ich durch Zahleneingabe, bestimmte Zellen in den Indexfarben einfärben kann. Ich gebe eine Zahl ein und die Zelle und alle damit verbunden Zellen oder Zellen, welche die gleiche Funktion vorweisen müssen färben sich.

Nun gibt es nur 56 Indexfarben, welche zudem auch noch ziemlich grelle Farben sind. Ich hätte gerne ein größeres Spektrum an Farben, welches ich durch die RGB Farben bekommen kann. Nur weis ich nicht wie ich dies jetzt in meine Funktion einsetzen soll.

Ich habe nur ein Feld um eine Zahl reinzuschreiben und nicht 3, also ein Feld für R, eins für G und eins für B ist nicht umsetzbar.

Anbei meine VBA Programmierung:

Sub Farbe_Topic()

' Farbe_Topic Makro: Hier wird jetzt das "Status-Feld" in der gleichen Farbe formatiert, wie die, die auch in den ARbeitsblättern gewünscht ist

' Tastenkombination: Strg+w

Range("B2:C2").Select

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ColorIndex = Tabelle11.Cells(2, 3) ' In dieser Zelle steht zum Beispiel eine 3 --> somit Farbe rot

.TintAndShade = 0

.PatternTintAndShade = 0

Selection.Font.ColorIndex = Tabelle11.Cells(2, 11)

End With

Range("B3:C3").Select

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ColorIndex = Tabelle11.Cells(3, 3)

.TintAndShade = 0

.PatternTintAndShade = 0

Selection.Font.ColorIndex = Tabelle11.Cells(3, 11)

End With

Range("B4:C4").Select

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ColorIndex = Tabelle11.Cells(4, 3)

.TintAndShade = 0

.PatternTintAndShade = 0

Selection.Font.ColorIndex = Tabelle11.Cells(4, 11)

End With

Range("B5:C5").Select

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ColorIndex = Tabelle11.Cells(5, 3)

.TintAndShade = 0

.PatternTintAndShade = 0

Selection.Font.ColorIndex = Tabelle11.Cells(5, 11)

End With

Range("B6:C6").Select

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ColorIndex = Tabelle11.Cells(6, 3)

.TintAndShade = 0

.PatternTintAndShade = 0

Selection.Font.ColorIndex = Tabelle11.Cells(6, 11)

End With

Range("B7:C7").Select

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ColorIndex = Tabelle11.Cells(7, 3)

.TintAndShade = 0

.PatternTintAndShade = 0

Selection.Font.ColorIndex = Tabelle11.Cells(7, 11)

End With

Range("B8:C8").Select

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ColorIndex = Tabelle11.Cells(8, 3)

.TintAndShade = 0

.PatternTintAndShade = 0

Selection.Font.ColorIndex = Tabelle11.Cells(8, 11)

End With

Vielleicht hilft dieses Bild noch dabei:

...zum Beitrag

Excel VBA - Darstellung waagerecht-vertikal beim kopieren ändern?

Hallo,

ich habe in einer fertigen Tabelle etwas geändert, um die Eingabe der Daten zu erleichtern. Statt die Daten in der Spalte zu erfassen, werden die Daten jetzt in einer Zeile eingegeben.

Also statt vorher in B10, B11, B12... jetzt in B10, C10, D10...

Die Daten werden mit Hilfe eine Makros in eine andere Tabelle transferiert und waagerecht eingefügt.

Da ich aber die Eingabeart verändert habe, werden die Daten jetzt untereinander in die Tabelle eingefügt.

Ich weiß, dass das mit "Application.Transpose" zu tun hat.

Nun weiss ich aber nicht wie ich die Zeile umbenennen muss, damit die waagerechte Darstellung übernommen wird.

Wie ändere ich die Zeile, damit die angesprochenen Werte waagerecht in die Zeile kopiert werden?

Hier der komplette Code:

Sub transfer_werte()
    Dim rngKunde    As Excel.Range
    Dim rngReklam   As Excel.Range
    Dim rngArtikel   As Excel.Range

     Set rngKunde = Worksheets("Eingaben").Range("C5:C10")
    Set rngReklam = Worksheets("Eingaben").Range("D5:D9")
    Set rngArtikel = Worksheets("Eingaben").Range("C14:L14")
   
        With Worksheets("Liste")
          With .Cells(.Rows.Count, 2).End(xlUp)
               .Offset(1, 0).Resize(rngKunde.Columns.Count, rngKunde.Rows.Count).Value = Application.Transpose(rngKunde.Value)
        End With
    End With
   
    With Worksheets("Liste")
        With .Cells(.Rows.Count, 8).End(xlUp)
             .Offset(1, 0).Resize(rngReklam.Columns.Count, rngReklam.Rows.Count).Value = Application.Transpose(rngReklam.Value)
        End With
    End With
  
   With Worksheets("Liste")
        With .Cells(.Rows.Count, 14).End(xlUp)
             .Offset(1, 0).Resize(rngArtikel.Columns.Count, rngArtikel.Rows.Count).Value = Application.Transpose(rngArtikel.Value)
        End With
    End With
      
End Sub

...zum Beitrag

Combobox mit Daten einer Spalte(B) füllen aber nur,wo in der gleichen Zeile in Spalte(G) nein steht

        Private Sub UserForm_Initialize()
With Me.txtDatum.Value = Date


   Dim r As Range
With Worksheets("Daten")
        Set r = .Range("B1", .Range("B65536").End(xlUp))
ComboBox1.RowSource = "Daten!" & r.Address
End With
End With




End Sub

Ist es möglich, dass die combobox all jene Daten herausfiltert wo, in Spalte G nein steht? Also praktisch dass es mir nurmehr jene Daten aus Spalte B in der Combobox anzeigt wo in der gleichen Zeile in Spalte G ein nein steht ? Danke im Voraus

...zum Beitrag

EXCEL Tab. Inhalte mit Outlook senden?

Guten Morgen, ich hab mal eine Frage zu einem VBA.

Mein Code sendet zwar die E-Mail, nimmt aber den Dateiinhalt nicht mit. Kann mir da jemand helfen? Gruß

Hier mein Code: Public Sub Änderungen_Click()


    sMailtext = "Aktueller Änderungsumfang / Raum für weitere Informationen:  "
    
    With CreateObject("Outlook.Application").CreateItem(0)
        .GetInspector
            .Subject = "Änderungen"
                .Body = sMailtext & .Body
                        .Importance = 1
                    .To = "###########@t-online.de"
                    '   .Display
        With .GetInspector.WordEditor.Application.Selection
             ThisWorkbook.Worksheets("Info").Range("A1").CurrentRegion.Copy
                 .Start = Len(sMailtext)
                     .End = Len(sMailtext)
                         '   .Paste
                End With
                    
                    .Send


            End With
    End
End Sub

...zum Beitrag

Excel: Verbessertes Logging mit VBA Makro?

Hallo Zusammen

ich verwende im Moment ein kurzes Makro, um Änderungen in einem Tabellenblatt zu loggen.

Es registriert aber nur einzelne Änderungen, nicht multi-selektion oder Löschen von Spalten. Kann ich das mit separaten Privaten Subs übernehmen?

Und kann ich aufnehmen, was die Target- und "PreVal"-Adresse war (Offset 4+5)

Code:

Dim PreVal
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
PreVal = Target.Value
 
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
  
    On Error GoTo 0
    
    If Target.Value <> PreVal Then
        With Sheets(2).Cells(Rows.Count, 1).End(xlUp)
            .Offset(1, 0) = Now
            .Offset(1, 1) = PreVal
            .Offset(1, 2) = Target.Value
            .Offset(1, 3) = Environ("Username")
        End With
    End If
 
End Sub

...zum Beitrag

Excel VBA: Text aus Inputbox in Zelle ergänzen (nicht überschreiben)

Hallo ihr Lieben Excel-Profis,

ich hab ein kleines Excel-File, welches ich täglich öffne und wo ich zum aktuellen Datum einen Eintrag mache). Das passiert über eine Inputbox. Wenn ich aber das Excel ein zweites Mal öffne und einen neuen Text eingeben, dann überschreibt es mir den alten Text. Ich würde jetzt gerne mein Makro so umbauen, dass ich den Text in die Zelle dazuschreibe. Sub eintragen()

Dim x As Range Dim symptom As String

symptom = InputBox("heutige Symptome:", "In Spalte D", "") If symptom = "" Then Exit Sub With Sheets("Kalender") Set x = .Range("D:D").Find(Date) If x Is Nothing Then MsgBox "Der " & Date & " wurde nicht gefunden!" Else .Cells(x.Row, 6) = symptom End If End With End Sub

Bitte um Unterstützung!

Danke! :-)

...zum Beitrag

VBA: Zwei Spalten mit Wert multiplizieren und dann addieren mit Hilfe von Makros

Hallöchen,

ich habe folgendes Problem Ich habe zwei Spalten die ich jeweils miteinander addieren möchte. Doch bevor ich diese addiere, möchte ich Spalte B mit dem Wert aus der TextBox1 multiplizieren und Spalte C mit dem Wert aus Textbox2. Danach sollen beide Spalten miteinander addiert und dann sortiert werden. Spalte D ist in diesem Fall die Ergebnisspalte. Das Programm hat auch schon funktioniert, jedoch habe ich vorher nur die spalten addiert und sortiert.

HIer mein bereits geschriebener Code:

Private Sub CommandButton1_Click()



' Prüfen ob Lastspitzen eingetragen wurden, ansonsten Fehlermeldung

        If TextBox1.Value = "" Or TextBox2.Value = "" Then
        MsgBox "Bitte geben Sie eine Lastspitze ein!"
     
Else
        
Dim wks As Excel.Worksheet
Dim lngLetzteZeile As Long
Dim Last1 As Integer
Dim Last2 As Integer
Last1 = TextBox1.Value
Last2 = TextBox2.Value  

Set wks = ActiveWorkbook.Worksheets("Vergleich")


With wks
 
lngLetzteZeile = .Cells(.Rows.Count, "B").End(xlUp).Row
If lngLetzteZeile < 15 Then Exit Sub

 With .Range("D15:D" & lngLetzteZeile)
 'berechne: D := B + C
 .FormulaR1C1 = "=RC[-2]*Last1+RC[-1]*Last2"
 'Formeln durch deren Ergebnis ersetzen
 .Value = .Value
 End With
 
With .Range("B15:D" & lngLetzteZeile)
 .Sort Key1:=.Cells(2), Order1:=xlDescending, _
 DataOption1:=xlSortTextAsNumbers, _
 SortMethod:=xlPinYin
End With

End With
End If


End Sub

...zum Beitrag

Wie kann ich bei Excel einen Button erstellen der abspeichert?

Hallo,

Ich würde gerne bei Excel einen Button erstellen, der die Excel mappe auf dem Desktop abspeichert. Der Name der Datei soll in Zeile A1 stehen.

Den Button habe ich bereits erstellt. Ich scheitere noch bei dem Makro, weil ich keine ahnung davon habe. Ich habe etwas im Internet gefunden, was meinen Vorstellungen nahe kommt. Ich habe versucht es anzupassen, aber irgendwie klappt das alles nicht.

Sub Schaltfläche1_Klicken()
Dim lw_pfad As String
lw_pfad = ActiveSheet.Range("A1").Value
lw_pfad = InputBox("Geben Sie hier das Laufwerk und den Pfad an, wo die Datei gespeichert werden soll." & Chr(13) & Chr(13) & "(Ihre Eingabe wird in A1 als neuer Default-Wert gespeichert.)", "Datei speichern unter...", lw_pfad)
If lw_pfad = "" Then
  MsgBox "Die Datei wird nicht gespeichert, da Sie [Abbrechen] gedrückt oder nichts eingegeben haben.", , "Abbruch"
  Exit Sub
Else
  If Right(lw_pfad, 1) <> "\" Then lw_pfad = lw_pfad & "\"
  ActiveSheet.Range("A1").Value = lw_pfad
Rem MsgBox lw_pfad
ActiveWorkbook.SaveAs lw_pfad & ActiveSheet.Range("B2").Value & ActiveSheet.Range("C4").Value & ".xls"
MsgBox "Die Datei wurde unter " & lw_pfad & ActiveSheet.Range("B2").Value & ActiveSheet.Range("C4").Value & ".xls gespeichert.", , "OK"
End If
End Sub

Das ist, was ich bis jetzt habe.

Vielen Dank für die Hilfe im Voraus!

...zum Beitrag

VBA Makro Excel Letzte beschriebene Zeile vor Leerzeile, weitere Leerzeile einfügen

Guten Tag,

ich suche einen Code für ein Makro,dass in Spalte B unter der letzten beschriebenen Zelle vor einer leeren Zelle (also nicht am kompletten Ende des Sheets) eine Leerzeile einfügt. Habe schon etliche codes ausprobiert, zb

Sub letzte_Zeile()

'letzte benutzte Zelle in Spalte 2 finden DIM Ende As Long With ActiveSheet

Ende = .Cells(Rows.Count, 2).End(xlUp).Row End With

End Sub

Dieser sollte mir eig die letzte beschriebene Anzeigen,es funktioniert aber Garnichts.

Freue mich über Vorschläge. Viele Grüße

...zum Beitrag

App programmieren VBA Excel?

Wie kann man eine Excel Datei mit Makros als App umwandeln. Bzw kann man eine App bauen und Excel samt Makros iwie einbetten?

...zum Beitrag

VBA ComboBox RemoveItem?

Wie kann ich die Items in ComboBox2 an Value von ComboBox1 anpassen? Z.B. Wenn in ComboBox1 Item1 ausgewählt ist soll in ComboBox2 Item1a und Item1b angezeigt werden, wenn ich jetzt aber in ComboBox1 Item2 auswähle soll in ComboBox2 Item2a und Item2b angezeigt werden. Mit dem folgenden Code werden die Items erstellt aber leider Löschen sich die Items nicht bei einer anderen Auswahl in ComboBox1:

If ComboBox1.Value = "Item1" Then

With Me.ComboBox2

.AddItem "Item1a"

.AddItem "Item1b"

End With

End If

If ComboBox1.Value = "Item2" Then

With Me.ComboBox2

.AddItem "Item2a"

.AddItem "Item2b"

End With

End If

.RemoveItem "Name des Items" hat nicht geklappt.

...zum Beitrag

Was möchtest Du wissen?

Deine Frage stellen