VBA : wie erstelle ich Kombinationen mit einem if?

Moin!

Ich tue mich extrem schwer mit dem lernen, aber ich versuchs weiter.

Ich habe nun versucht etwas zu erstellen, das in excel wie die "wenn" funktion, funktioniert, aber ich bekomme es nicht hin.

Ich habe eine Lösung gefunden, wie ich kombinationen erstelle und möchte diese nun verfeinern.

Mir geht es darum das B und C kombiniert werden, aber nichts doppelt ist( aber nur wenn es spalten übergreifen ist!)

Wenn da jemand helfen kann und lust, auf eine umfangreiche erklärung hat, dann freut mich das, ansonsten versuche ich mir die erklärung selber bei zu bringen. :)

Sub Alle()                                             'Name


Dim xDRg1, xDRg2 As Range                                   'Namen der Tabelle als "fortlaufenden bereich"
Dim xRg  As Range                                           '
Dim xStr As String                                          ' String für das leerzeichen
Dim xFN1, xFN2 As Integer                        
Dim xSV1, xSV2 As String

Set xDRg1 = Range("B2:B11")                                 'Tabelle 1
Set xDRg2 = Range("C2:C11")                                 'Tabelle 2


xStr = " "                                                  'Trennzeichen

Set xRg = Range("L5")                                       'Zelle für die Ausgabe


' wenn zeichen 1&2 aus der ersten Zelle in "B"  "nicht gleich" Zeichen 1&2 oder 4&5( wegen dem leerzeichen)aus der ersten Zelle aus "C",
' oder wenn zeichen 4&5 aus der ersten Zelle in "B"  "nicht gleich" Zeichen 1&2 oder 4&5( wegen dem leerzeichen)aus der ersten Zelle aus "C" sind,
' dann soll: ( ansonsten überspringen)

For xFN1 = 1 To xDRg1.Count
    xSV1 = xDRg1.Item(xFN1).Text
    
For xFN2 = 1 To xDRg2.Count
    xSV2 = xDRg2.Item(xFN2).Text
      

    
    
    xRg.Value = xSV1 & xStr & xSV2
        Set xRg = xRg.Offset(1, 0)                'Schreiben in die Zelle

       Next                                            'Ende der For Schleife
Next                                                 'Ende der For Schleife

End Sub


Bild zu Frage
Computer, Microsoft Excel, VBA, Informatik
Kann man den Benutzernamen in einem UserForm Label angeben, der das Dokument geöffnet hat?

Hi, ich liebe Herausforderungen und komme auch nach und nach weiter. Nun habe ich diese Funktion welche prüft, ob eine bestimmte Datei geöffnet ist:

Public Function IsFileOpen(FileName As String)
    Dim filenum As Integer, errnum As Integer
    On Error Resume Next
    filenum = FreeFile()
    Open FileName For Input Lock Read As #filenum
    Close filenum
    errnum = Err
    On Error GoTo 0
    Select Case errnum
    Case 0
    IsFileOpen = False
    Case 70
    IsFileOpen = True
    Case Else
    Error errnum
    End Select
End Function

Mit dieser Funktion kann ich arbeiten, wenn das Dokument von wem auch immer geöffnet ist, öffnet sich eine UserForm.

Nun möchte ich gerne mit dieser Funktion ermitteln, welcher Benutzer das Dokument geöffnet hat:

Public Function LastUser(strPath As String) As String
    Dim strXl As String
    Dim strFlag1 As String, strflag2 As String
    Dim i As Integer, j As Integer
    Dim hdlFile As Long
    Dim lNameLen As Byte
   
    strFlag1 = Chr(0) & Chr(0)
    strflag2 = Chr(32) & Chr(32)
   
    hdlFile = FreeFile
    Open strPath For Binary As #hdlFile
        strXl = Space(LOF(hdlFile))
        Get 1, , strXl
    Close #hdlFile
   
    j = InStr(1, strXl, strflag2)
   
    #If Not VBA6 Then
        '// Xl97
        For i = j - 1 To 1 Step -1
            If Mid(strXl, i, 1) = Chr(0) Then Exit For
        Next
        i = i + 1
    #Else
        '// Xl2000+
        i = InStrRev(strXl, strFlag1, j) + Len(strFlag1)
    #End If
   
    '// IFM
    lNameLen = Asc(Mid(strXl, i - 3, 1))
    LastUser = Mid(strXl, i, lNameLen)
End Function

Aber das klappt nicht...

Ich habe es mit diesem Code probiert und diesen an meinen Pfad und das Dokument angepasst:

Private Sub TestVBA()
'http://www.xcelfiles.com/IsFileOpenVBA.htm
'// Just change the file to test here
Const strFileToOpen As String = "C:\Data.xls"
If IsFileOpen(strFileToOpen) Then
MsgBox strFileToOpen & " is already Open" & _
vbCrLf & "By " & LastUser(strFileToOpen), vbInformation, "File in Use"
Else
MsgBox strFileToOpen & " is not open", vbInformation
End If
End Sub

Bekomme immer Fehler 52.

Ich würde aber gerne den Benutzernamen auch später in der UserForm (anstatt einer MsgBox) im Label anzeigen, was ich ebenfalls nicht hinbekomme.

Weiß jemand, wie ich den Benutzernamen ermittel, der das Dokument geöffnet hat und ich diesen dann in den Label-Text einbauen kann? Oder geht das nicht?

Vielen herzlichen Dank im Voraus.

Microsoft Excel, VBA, VBA Excel
Kann Excel das ohne VBA?

Guten Tag liebes Forum,

Vorab sei gesagt, dass ich aufgrund von dienstlichen Vorgaben keine Screenshots meiner Arbeitsmappe anhängen kann. Ich hoffe, dass der Ein oder Andere mir dennoch helfen kann.

Folgender Sachverhalt:
Meine Excel-Arbeitsmappe enthält zwei Arbeitsblätter:
- "Bezüge" (dieses wird als Datenbank genutzt, um das Hauptblatt sauber zu halten)
- "Anwesenheit"

Im Blatt "Bezüge" sind in den Zellen F2:DW2 Wochentage (abgekürzt) aufgelistet. In den Zellen F3:DW3 das dazugehörige Datum.

Samstage sowie Sonntage sind durch bedingte Formatierung "grau" hinterlegt.

Im Blatt "Anwesenheit" stehen ganz viele Namen untereinander und oben drüber von links nach recht die Wochentage sowie in einer Zelle darunter das jeweilige Datum. Quasi identisch mit "Bezüge"

Auch hier ist das Färben der Samstage sowie Sonntage keine große Problematik, wenn bedingte Formatierung genutzt wird. Allerdings steh ich ein wenig auf dem Schlauch, wenn es darum geht das zugehörige Datum zum Wochentag in identischer Farbe (wie die bedingte Formatierung den Wochentag) darzustellen.

Zusätzlich sei gesagt, dass alle Wochentage und Datum-Angaben im Blatt "Anwesenheit" mit "=WENN" bzw. "=WENN(UND"- Formeln erzeugt werden und sich entsprechend auf "Bezüge" beziehen.

Gibt es hierfür eine eigene Formel oder eine Möglichkeit vorhandene Formeln in der Zielzelle zu ergänzen?

Grundsätzlich wäre auch eine VBA-Lösung annehmbar. ich bin zwar Neueinsteiger aber mit 30/40 Zeilen VBA sollte ich irgendwie zurecht kommen.

Ganz ganz lieben Dank und beste Grüße.

Microsoft Excel, VBA
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:

Bild zu Frage
Microsoft Excel, VBA
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
Computer, Microsoft Excel, Microsoft Office, Makro, VBA, Code
Excel VBA - Nach kopieren anderen Zelleninhalt "zurückwerfen"?

Hallo,

ich habe eine Formularseite gebastelt, bei der eingegebene Daten in eine Liste eingefügt werden. Nun möchte ich, dass das Makro, welches die Daten in das andere Blatt in eine neue Zeile kopiert hat, auf der Formularseite die Zeilennummer in ein Feld einträgt.

Die Eingabeseite heißt "Eingaben" und das Blatt mit der Liste heißt "Liste"

Beispiel:

Ich gebe Daten ein, klicke den Button an auf dem das Makro liegt, und die Daten werden nach "Liste" in Zeile 10 kopiert (während Zeilen 5-9 schon Daten enthalten aus vorherigen Übertragungen).

In dem selben Makro soll nun am Ende die Nummer, die in A10 steht (In Zeile A stehen von mir eigens vergebene Nummern), auf der Eingabeseite in das Feld B10 kopiert werden.

Anders formuliert:

Spalte A (Lliste) enthält Reklamationsnummern, fortlaufend. Beginnend mit RK20220001.

Wenn ich jetzt in der "Eingaben"-Seite meine Daten erfasse und das Makro nutze, werden die eingegebenen Daten in die "Liste" kopiert. Es wird automatisch immer die letzte Zeile gefüllt, ab Spalte B.

Nun möchte ich, dass die Reklamationsnr., die neben den zuletzt eingefügten Daten steht, in das "Eingaben"-Blatt in das Feld B10 kopiert wird.

Denn die Eingabefelder sind bereits so formatiert, dass man ein Etikett drucken kann, das dann an die Ware kann. Damit man nicht immer manuell die Nummer raus suchen muss, soll sie halt automatisch dort rein.

Computer, Office, Visual Basic, Microsoft Excel, Technik, programmieren, VBA, Technologie
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
Computer, Software, Office, Microsoft Excel, programmieren, VBA

Meistgelesene Fragen zum Thema VBA