Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 21:51:33
Idee für Grafik
26.04.2024 21:29:07
PQ zufällige Reihenfolge
26.04.2024 17:18:47
Große Datenmenge in komplexes Diagramm verpacken
26.04.2024 16:22:47
Aktualisierung Verknüpfung bei geschlossener Quelldatei
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1288to1292
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1288to1292
1288to1292
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

GoTo in For-Schleife & If-Abfrage in MsgBox

GoTo in For-Schleife & If-Abfrage in MsgBox
30.11.2012 17:41:05
Steffi
Hallo zusammen,
habe eine Mitarbeiter-Datei in der ich Daten von mehreren Mitarbeitern reinkopieren muss (aus Vergleichszwecken). Die Datenquellen (auch Excel-Dateien und komplett vom Aufbau und den Einträgen identisch außer das in Zelle B7 der Mitarbeitername steht nach dem ich in meinem Code suche und mit dem Feld in meiner Tabelle vergleiche um die Daten in die richtigen Zeilen zu kopieren) sind von den einzelnen Mitarbeitern auszufüllen und nach einer bestimmten Ordnerstruktur abzuspeichern. Die Daten aus den einzelnen Excel-Dateien muss ich öffnen und die Daten kopieren und in meine Datei einfügen. Jetzt habe ich in VBA einen Code geschrieben um mir die Arbeit zu erleichtern.
Zum besseren Verständnis habe ich die Datei hochgeladen (aus datenschutzgründen verändert):
https://www.herber.de/bbs/user/82831.xls
Ich habe in Tabelle1 eine Tabelle angelegt in der ich die Hyperlinks der Dokumente platziere (entsprechend der Mitarbeiter). Durch anklicken eines Update-Buttons kann ich auswählen ob die Daten des jeweiligen Mitarbeiters kopiert und eingefügt werden sollen oder nicht.
Dies geschieht in dem ich über eine For-Schleife die Hyperlinks als meine "ImportDatei" deklariere (siehe Code unten) und prüfe ob in der Spalte C "Ja" steht.
Problem 1:
Sobald ein Fehler auftritt weil ich einen Fehler beim kopieren des Hyperlinks gemacht habe und der Link nicht existiert bricht das Programm ab. Dies habe ich mit dem GoTo-Befehl abfangen wollen der aber nicht zielführend arbeitet sondern immer angezeigt wird.
Ich glaube das hängt mit der For-Schleife zusammen?!
Problem2:
Ich möchte das mir durch eine MsgBox angezeigt wird nachdem die Daten eingefügt wurden, welche eingefügt wurden
Codeabschnitt:
MsgBox "Folgende MA-Daten wurden aktualisiert:" & Chr(13) & "MA1" & Chr(13) & "MA2" & Chr(13) & "MA5"
Hier soll er die Zellen A7:A11 aus Tabelle1 anzeigen wenn in der entsprechenden Spalte C "Ja" steht...
D.h. ich brauche irgendwie eine IF-Abfrage in der MsgBox?
Private Sub CommandButton1_Click()
Dim ImportDatei
Dim wbImport As Workbook
Application.ScreenUpdating = False
For i = 7 To 11
If Worksheets("Tabelle1").Cells(i, 3) = "Ja" Then
ImportDatei = Worksheets("Tabelle1").Cells(i, 2)
On Error GoTo Failure
Set wbImport = Workbooks.Open(ImportDatei)
wbImport.Worksheets("MA-Daten").Range("C1, C3, C5, C7, C9, C11, C13, C15, C17, C19, C21,  _
C23").Copy
If wbImport.Sheets("MA-Daten").Range("B7").Value = "MA1" Then
ThisWorkbook.Sheets("MA-Daten").Range("E17").PasteSpecial Paste:=xlValues
ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA2" Then
ThisWorkbook.Sheets("MA-Daten").Range("E29").PasteSpecial Paste:=xlValues
ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA3" Then
ThisWorkbook.Sheets("MA-Daten").Range("E41").PasteSpecial Paste:=xlValues
ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA4" Then
ThisWorkbook.Sheets("MA-Daten").Range("E53").PasteSpecial Paste:=xlValues
ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA5" Then
ThisWorkbook.Sheets("MA-Daten").Range("E65").PasteSpecial Paste:=xlValues
End If
wbImport.Worksheets("MA-Daten").Range("H2, K2, N2, Q2, T2, W2, Z2, AC2, AF2, AI2, AL2, AO2,  _
_
AR2, AU2, AX2, BA2, BD2, BG2, BJ2, BM2, BP2, BS2, BV2, BY2, CB2, CE2, CH2, CK2, CN2, CQ2, CT2,  _
CW2, CZ2, DC2, DF2, DI2, DL2, DO2").Copy
If wbImport.Sheets("MA-Daten").Range("B7").Value = "MA1" Then
ThisWorkbook.Sheets("MA-Daten").Range("G17").PasteSpecial Paste:=xlValues
ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA2" Then
ThisWorkbook.Sheets("MA-Daten").Range("G29").PasteSpecial Paste:=xlValues
ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA3" Then
ThisWorkbook.Sheets("MA-Daten").Range("G41").PasteSpecial Paste:=xlValues
ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA4" Then
ThisWorkbook.Sheets("MA-Daten").Range("G53").PasteSpecial Paste:=xlValues
ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA5" Then
ThisWorkbook.Sheets("MA-Daten").Range("G65").PasteSpecial Paste:=xlValues
End If
wbImport.Worksheets("MA-Daten").Range("H3, K3, N3, Q3, T3, W3, Z3, AC3, AF3, AI3, AL3, AO3,  _
_
AR3, AU3, AX3, BA3, BD3, BG3, BJ3, BM3, BP3, BS3, BV3, BY3, CB3, CE3, CH3, CK3, CN3, CQ3, CT3,  _
CW3, CZ3, DC3, DF3, DI3, DL3, DO3").Copy
If wbImport.Sheets("MA-Daten").Range("B7").Value = "MA1" Then
ThisWorkbook.Sheets("MA-Daten").Range("G78").PasteSpecial Paste:=xlValues
ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA2" Then
ThisWorkbook.Sheets("MA-Daten").Range("G90").PasteSpecial Paste:=xlValues
ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA3" Then
ThisWorkbook.Sheets("MA-Daten").Range("G102").PasteSpecial Paste:=xlValues
ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA4" Then
ThisWorkbook.Sheets("MA-Daten").Range("G114").PasteSpecial Paste:=xlValues
ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA5" Then
ThisWorkbook.Sheets("MA-Daten").Range("G126").PasteSpecial Paste:=xlValues
End If
wbImport.Worksheets("MA-Daten").Range("H5, K5, N5, Q5, T5, W5, Z5, AC5, AF5, AI5, AL5, AO5,  _
_
AR5, AU5, AX5, BA5, BD5, BG5, BJ5, BM5, BP5, BS5, BV5, BY5, CB5, CE5, CH5, CK5, CN5, CQ5, CT5,  _
CW5, CZ5, DC5, DF5, DI5, DL5, DO5").Copy
If wbImport.Sheets("MA-Daten").Range("B7").Value = "MA1" Then
ThisWorkbook.Sheets("MA-Daten").Range("G18").PasteSpecial Paste:=xlValues
ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA2" Then
ThisWorkbook.Sheets("MA-Daten").Range("G30").PasteSpecial Paste:=xlValues
ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA3" Then
ThisWorkbook.Sheets("MA-Daten").Range("G42").PasteSpecial Paste:=xlValues
ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA4" Then
ThisWorkbook.Sheets("MA-Daten").Range("G54").PasteSpecial Paste:=xlValues
ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA5" Then
ThisWorkbook.Sheets("MA-Daten").Range("G66").PasteSpecial Paste:=xlValues
End If
wbImport.Worksheets("MA-Daten").Range("H6, K6, N6, Q6, T6, W6, Z6, AC6, AF6, AI6, AL6, AO6,  _
_
AR6, AU6, AX6, BA6, BD6, BG6, BJ6, BM6, BP6, BS6, BV6, BY6, CB6, CE6, CH6, CK6, CN6, CQ6, CT6,  _
CW6, CZ6, DC6, DF6, DI6, DL6, DO6").Copy
If wbImport.Sheets("MA-Daten").Range("B7").Value = "MA1" Then
ThisWorkbook.Sheets("MA-Daten").Range("G79").PasteSpecial Paste:=xlValues
ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA2" Then
ThisWorkbook.Sheets("MA-Daten").Range("G91").PasteSpecial Paste:=xlValues
ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA3" Then
ThisWorkbook.Sheets("MA-Daten").Range("G103").PasteSpecial Paste:=xlValues
ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA4" Then
ThisWorkbook.Sheets("MA-Daten").Range("G115").PasteSpecial Paste:=xlValues
ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA5" Then
ThisWorkbook.Sheets("MA-Daten").Range("G127").PasteSpecial Paste:=xlValues
End If
Application.CutCopyMode = False
wbImport.Close savechanges:=False
Set wbImport = Nothing
End If
Next i
MsgBox "Folgende MA-Daten wurden aktualisiert:" & Chr(13) & "MA1"  & Chr(13) & "MA2" & Chr(  _
_
13) & "MA5"
Range("C1").Select
Application.ScreenUpdating = True
Failure:
MsgBox "Achtung! Der Pfad in der angeklickten Zelle konnte nicht gefunden werden! " & Chr(  _
_
13) & Chr(13) & "Bitte überprüfen Sie den Pfad!"
ThisWorkbook.Worksheets("Tabelle1").Activate
Worksheets("Tabelle1").Cells(i, 2).Select
End Sub

Ich hoffe es ist halbwegs nachvollziehbar :).
Ich DANKE euch schon im Voraus für Eure Mithilfe!!!
Liebe Grüße
Steffi

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Naja, ...
30.11.2012 18:14:20
Luc:-?
…Steffi,
dann mal los …
zu 1.: Nein, sondern damit, dass die F-Behandlung im normalen PgmPfad steht und deshalb immer zum PgmEnde erreicht wird. Ein typischer Anfängerfehler. Bei normalem Ablauf muss/kann das hier mit einem Exit Sub vor der F-Behandl vermieden wdn. Außerdem würde ich On Error GoTo Failure bereits vor der Schleife notieren.
zu 2.: Dafür kannst du die vbFkt IIf verwenden (sog duales If), die iW der xlFkt WENN entspricht. Sind es mehrere Bedingungen mit jeweils anderer Reaktion, kann besser die vbFkt Switch benutzt wdn. Beide Fktt sind (besonders in Verbindung mit einer MsgBox) aber nur erfolgreich, wenn dabei kein Fehler auftritt bzw ein Fehlerwert oder sonst ein Wert, der von einer MsgBox nicht verwendet wdn kann, zurückgegeben wird. Kann das nicht garantiert wdn, muss das mit der klassischen Methode abgefangen wdn. Dann musst du eben mehrere verschiedene Meldungen vorsehen.
Gruß+schöWE, Luc :-?
Besser informiert mit …!

Anzeige
AW: Naja, ...
01.12.2012 04:57:02
schauan
Hallo Steffi,
ich schreibe bei der Fehlerbehandlung auch gern If err Then Msgbox ...
Dadurch wird die Meldung nur bei einem Fehler ausgegeben.
Wenn Du verschiedene Fehler auswerten willst, kannst Du auch nach err.number differenzieren.
Wenn die Fehlerbehandlung nur an bestimmten Stellen wirken soll, z.B. beim Öffnen der Datei, solltest Du danach gleich wieder On error goto 0 programmieren.
Die Daten für die msgbox könntest Du auch in den if-Zweigen zusammenstellen und in eine Stringvariable packen. In der Meldung verwendest Du dann die Stringvariable.
Grüße, André

Anzeige
Fehler im String sammeln und ausgeben
01.12.2012 13:13:05
Tino
Hallo,
ich mach es meist so.
Ich sammle die Fehler in einem String und geben diese am Ende gesammelt aus.
Dafür ist es vorteilhaft über eine seberaten Sub oder Function
wie im Beispiel zu prüfen ob die Datei vorhanden ist.
Hier mal Beispielhaft was in Deinen Code eingebaut, ist evtl. noch ausbaufähig.
kommt als Code in Tabelle4 
Option Explicit 
 
Private Sub CommandButton1_Click() 
Dim lngRow& 
Dim wbImport As Workbook 
Dim ImportDatei$, sFehler$, sMAAktuell$, sFile$ 
 
Application.ScreenUpdating = False 
 
With Worksheets("Tabelle1") 
For lngRow = 7 To 11 
    If .Cells(lngRow, 3) = "Ja" Then 
        sFile = .Cells(lngRow, 2).Value 
        If .Cells(lngRow, 2).Hyperlinks.Count > 0 Then 
            ImportDatei = Check_Link_Path(.Cells(lngRow, 2).Hyperlinks(1).Address) 
        End If 
        If ImportDatei <> "" Then 
            If Not (ImportDatei Like "*.xls" And ImportDatei Like "*.xlsx" And ImportDatei Like "*.xlsm") Then 
                ImportDatei = "" 
            End If 
        End If 
        If ImportDatei <> "" Then 
            Set wbImport = Workbooks.Open(ImportDatei) 
             
            wbImport.Worksheets("MA-Daten").Range("C1, C3, C5, C7, C9, C11, C13, C15, C17, C19, C21, C23").Copy 
                If wbImport.Sheets("MA-Daten").Range("B7").Value = "MA1" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("E17").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA2" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("E29").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA3" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("E41").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA4" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("E53").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA5" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("E65").PasteSpecial Paste:=xlValues 
                End If 
             
            wbImport.Worksheets("MA-Daten").Range("H2, K2, N2, Q2, T2, W2, Z2, AC2, AF2, AI2, AL2, AO2, AR2, " & _
                "AU2, AX2, BA2, BD2, BG2, BJ2, BM2, BP2, BS2, BV2, BY2, CB2, CE2, CH2, CK2, CN2, CQ2, CT2, CW2, CZ2, DC2, DF2, DI2, DL2, DO2").Copy 
                If wbImport.Sheets("MA-Daten").Range("B7").Value = "MA1" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G17").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA2" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G29").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA3" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G41").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA4" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G53").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA5" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G65").PasteSpecial Paste:=xlValues 
                End If 
                 
            wbImport.Worksheets("MA-Daten").Range("H3, K3, N3, Q3, T3, W3, Z3, AC3, AF3, AI3, AL3, AO3, AR3, AU3, " & _
                "AX3, BA3, BD3, BG3, BJ3, BM3, BP3, BS3, BV3, BY3, CB3, CE3, CH3, CK3, CN3, CQ3, CT3, CW3, CZ3, DC3, DF3, DI3, DL3, DO3").Copy 
                If wbImport.Sheets("MA-Daten").Range("B7").Value = "MA1" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G78").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA2" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G90").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA3" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G102").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA4" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G114").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA5" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G126").PasteSpecial Paste:=xlValues 
                End If 
             
            wbImport.Worksheets("MA-Daten").Range("H5, K5, N5, Q5, T5, W5, Z5, AC5, AF5, AI5, AL5, AO5, AR5, AU5, AX5, " & _
                "BA5, BD5, BG5, BJ5, BM5, BP5, BS5, BV5, BY5, CB5, CE5, CH5, CK5, CN5, CQ5, CT5, CW5, CZ5, DC5, DF5, DI5, DL5, DO5").Copy 
                If wbImport.Sheets("MA-Daten").Range("B7").Value = "MA1" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G18").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA2" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G30").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA3" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G42").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA4" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G54").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA5" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G66").PasteSpecial Paste:=xlValues 
                End If 
                 
            wbImport.Worksheets("MA-Daten").Range("H6, K6, N6, Q6, T6, W6, Z6, AC6, AF6, AI6, AL6, AO6, AR6, AU6, AX6, " & _
                "BA6, BD6, BG6, BJ6, BM6, BP6, BS6, BV6, BY6, CB6, CE6, CH6, CK6, CN6, CQ6, CT6, CW6, CZ6, DC6, DF6, DI6, DL6, DO6").Copy 
                If wbImport.Sheets("MA-Daten").Range("B7").Value = "MA1" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G79").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA2" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G91").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA3" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G103").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA4" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G115").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA5" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G127").PasteSpecial Paste:=xlValues 
                End If 
             
            sMAAktuell = sMAAktuell & Worksheets("Tabelle1").Cells(lngRow, 1) & vbCr 
            wbImport.Close savechanges:=False 
            Application.CutCopyMode = False 
            Set wbImport = Nothing 
        Else 
            sFehler = sFehler & .Cells(lngRow, 1) & " - " & sFile & vbCr 
        End If 
        sFile = "" 
        ImportDatei = "" 
    End If 
Next lngRow 
End With 
     
If sMAAktuell <> "" Then 
    sMAAktuell = Left$(sMAAktuell, Len(sMAAktuell) - 1) 
    MsgBox "Folgende MA-Daten wurden aktualisiert:" & vbCr & vbCr & sMAAktuell 
End If 
Application.ScreenUpdating = True 
     
If sFehler <> "" Then 
    MsgBox "Bitte überprüfen Sie den Pfad!" & vbCr & vbCr & Left$(sFehler, Len(sFehler) - 1), vbExclamation, "Fehler in Hyperlink" 
    ThisWorkbook.Worksheets("Tabelle1").Activate 
End If 
End Sub
kommt als Code in Modul1 
Option Explicit 
 
Private Declare Function GetFullPathName Lib "kernel32.dll" Alias _
"GetFullPathNameA" (ByVal lpFileName As String, ByVal nBufferLength As Long, _
ByVal lpBuffer As String, ByVal lpFilePart As String) As Long 
 
 
Public Function GetRelativePath(PathTo As String) As String 
  Dim pszPath As String 
  Const MAX_PATH = 255 
  pszPath = Space(MAX_PATH) 
  'API-Funktion aufrufen 
  GetFullPathName PathTo, MAX_PATH, pszPath, vbNullString 
  'Rückgabe des relativierten Pfads 
  GetRelativePath = Left$(pszPath, InStr(pszPath, Chr(0)) - 1) 
End Function 
 
 
Function Check_Link_Path(strLinkPath$) As String 
Dim sFullPath$ 
On Error Resume Next 
sFullPath = GetRelativePath(strLinkPath) 
ChDrive sFullPath 
ChDir Left$(sFullPath, InStrRev(sFullPath, "\")) 
If Dir(sFullPath, vbNormal) <> "" Then 
    Check_Link_Path = sFullPath 
End If 
End Function
Gruß Tino

Anzeige
AW: Fehler im String sammeln und ausgeben
03.12.2012 10:50:47
Steffi
Hallo,
vielen Dank vorab für die zahlreichen Rückmeldungen!
@Tino:
Das Programm sieht sehr gut aus so wie es ist.
Leider zeigt er mir immer beim klicken auf den Button das Dialogfeld mit der Fehlermeldung („Failure“) an. Zwar passt das, weil er nur die anzeigt die ich mit „Ja“ deklariert habe, ABER der Pfad stimmt 100% den ich angegeben habe.
Also eig. müsste er ja dann die Datei öffnen, kopieren, einfügen und Datei wieder schließen und die MsgBox mit sMAAktuells anzeigen?
Es handelt sich um Netzwerkpfade. Kann es daran liegen?
Meine Kenntnisse in VBA beschränken sich leider auf Basiskenntnisse :)
Danke für Rückmeldungen!
Viele Grüße
Steffi

Anzeige
AW: Fehler im String sammeln und ausgeben
03.12.2012 16:51:38
Tino
Hallo,
versuche es noch einmal so.
Datei zuvor speichern, sonst passen die Hyperlinks manchmal nicht.
kommt als Code in Tabelle4 
Option Explicit 
 
Private Sub CommandButton1_Click() 
Dim lngRow& 
Dim wbImport As Workbook 
Dim ImportDatei$, sFehler$, sMAAktuell$, sFile$ 
 
Application.ScreenUpdating = False 
With Tabelle4 
For lngRow = 7 To 11 
    If .Cells(lngRow, 3) = "Ja" Then 
        sFile = .Cells(lngRow, 2).Value 
        If .Cells(lngRow, 2).Hyperlinks.Count > 0 Then 
             
            ImportDatei = Check_Link_Path(.Cells(lngRow, 2).Hyperlinks(1).Address) 
        End If 
        If ImportDatei <> "" Then 
            If Not (ImportDatei Like "*.xls" Or ImportDatei Like "*.xlsx" Or ImportDatei Like "*.xlsm") Then 
                ImportDatei = "" 
            End If 
        End If 
        If ImportDatei <> "" Then 
            Set wbImport = Workbooks.Open(ImportDatei) 
             
            wbImport.Worksheets("MA-Daten").Range("C1, C3, C5, C7, C9, C11, C13, C15, C17, C19, C21, C23").Copy 
                If wbImport.Sheets("MA-Daten").Range("B7").Value = "MA1" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("E17").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA2" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("E29").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA3" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("E41").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA4" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("E53").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA5" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("E65").PasteSpecial Paste:=xlValues 
                End If 
 
            wbImport.Worksheets("MA-Daten").Range("H2, K2, N2, Q2, T2, W2, Z2, AC2, AF2, AI2, AL2, AO2, AR2, " & _
                "AU2, AX2, BA2, BD2, BG2, BJ2, BM2, BP2, BS2, BV2, BY2, CB2, CE2, CH2, CK2, CN2, CQ2, CT2, CW2, CZ2, DC2, DF2, DI2, DL2, DO2").Copy 
                If wbImport.Sheets("MA-Daten").Range("B7").Value = "MA1" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G17").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA2" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G29").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA3" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G41").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA4" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G53").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA5" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G65").PasteSpecial Paste:=xlValues 
                End If 
 
            wbImport.Worksheets("MA-Daten").Range("H3, K3, N3, Q3, T3, W3, Z3, AC3, AF3, AI3, AL3, AO3, AR3, AU3, " & _
                "AX3, BA3, BD3, BG3, BJ3, BM3, BP3, BS3, BV3, BY3, CB3, CE3, CH3, CK3, CN3, CQ3, CT3, CW3, CZ3, DC3, DF3, DI3, DL3, DO3").Copy 
                If wbImport.Sheets("MA-Daten").Range("B7").Value = "MA1" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G78").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA2" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G90").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA3" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G102").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA4" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G114").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA5" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G126").PasteSpecial Paste:=xlValues 
                End If 
 
            wbImport.Worksheets("MA-Daten").Range("H5, K5, N5, Q5, T5, W5, Z5, AC5, AF5, AI5, AL5, AO5, AR5, AU5, AX5, " & _
                "BA5, BD5, BG5, BJ5, BM5, BP5, BS5, BV5, BY5, CB5, CE5, CH5, CK5, CN5, CQ5, CT5, CW5, CZ5, DC5, DF5, DI5, DL5, DO5").Copy 
                If wbImport.Sheets("MA-Daten").Range("B7").Value = "MA1" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G18").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA2" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G30").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA3" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G42").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA4" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G54").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA5" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G66").PasteSpecial Paste:=xlValues 
                End If 
 
            wbImport.Worksheets("MA-Daten").Range("H6, K6, N6, Q6, T6, W6, Z6, AC6, AF6, AI6, AL6, AO6, AR6, AU6, AX6, " & _
                "BA6, BD6, BG6, BJ6, BM6, BP6, BS6, BV6, BY6, CB6, CE6, CH6, CK6, CN6, CQ6, CT6, CW6, CZ6, DC6, DF6, DI6, DL6, DO6").Copy 
                If wbImport.Sheets("MA-Daten").Range("B7").Value = "MA1" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G79").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA2" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G91").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA3" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G103").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA4" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G115").PasteSpecial Paste:=xlValues 
                    ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA5" Then 
                    ThisWorkbook.Sheets("MA-Daten").Range("G127").PasteSpecial Paste:=xlValues 
                End If 
 
            sMAAktuell = sMAAktuell & Worksheets("Tabelle1").Cells(lngRow, 1) & vbCr 
            wbImport.Close savechanges:=False 
            Application.CutCopyMode = False 
            Set wbImport = Nothing 
        Else 
            sFehler = sFehler & .Cells(lngRow, 1) & " - " & sFile & vbCr 
        End If 
        sFile = "" 
        ImportDatei = "" 
    End If 
Next lngRow 
End With 
     
If sMAAktuell <> "" Then 
    sMAAktuell = Left$(sMAAktuell, Len(sMAAktuell) - 1) 
    MsgBox "Folgende MA-Daten wurden aktualisiert:" & vbCr & vbCr & sMAAktuell 
End If 
Application.ScreenUpdating = True 
     
If sFehler <> "" Then 
    MsgBox "Bitte überprüfen Sie den Pfad!" & vbCr & vbCr & Left$(sFehler, Len(sFehler) - 1), vbExclamation, "Fehler in Hyperlink" 
    ThisWorkbook.Worksheets("Tabelle1").Activate 
End If 
End Sub
kommt als Code in Modul1 
Option Explicit 
 
Private Declare Function GetFullPathName Lib "kernel32.dll" Alias _
"GetFullPathNameA" (ByVal lpFileName As String, ByVal nBufferLength As Long, _
ByVal lpBuffer As String, ByVal lpFilePart As String) As Long 
 
 
Public Function GetRelativePath(PathTo As String) As String 
  Dim pszPath As String 
  Const MAX_PATH = 255 
  pszPath = Space(MAX_PATH) 
  'API-Funktion aufrufen 
  GetFullPathName PathTo, MAX_PATH, pszPath, vbNullString 
  'Rückgabe des relativierten Pfads 
  GetRelativePath = Left$(pszPath, InStr(pszPath, Chr(0)) - 1) 
End Function 
 
 
Function Check_Link_Path(strLinkPath$) As String 
Dim sFullPath$ 
On Error Resume Next 
ChDrive ThisWorkbook.Path 
ChDir ThisWorkbook.Path 
sFullPath = GetRelativePath(strLinkPath) 
ChDrive strLinkPath 
ChDir Left$(sFullPath, InStrRev(sFullPath, "\")) 
If Dir(sFullPath, vbNormal) <> "" Then 
    Check_Link_Path = sFullPath 
End If 
End Function
Gruß Tino

Anzeige
AW: Fehler im String sammeln und ausgeben
03.12.2012 20:29:39
Steffi
Hallo Tino,
ein rießiges DANKESCHÖN an Dich!!!
Jetzt funktioniert es!
Allerdings habe ich noch einen Feher entdeckt der auftreten könnte. Und zwar wenn ein existierender Link eingefügt wird aber nicht der gewünschten Datei entspricht. Sprich wenn die Datei mit dem Makro dann geöffnet wird und das Worksheets "MA-Daten" in der Datei nicht existiert bricht das Makro ab..
Gibt es eine Möglichkeit bei dieser Eventualität auf diesen Code-Abschnitt zu "verweisen" bzw aufzurufen: 
If sFehler  "" Then
MsgBox "Bitte überprüfen Sie den Pfad!" & vbCr & vbCr & Left$(sFehler, Len(sFehler) - 1),  _
vbExclamation, "Fehler in Hyperlink"
ThisWorkbook.Worksheets("Tabelle1").Activate
End If
Die "falsche" Datei sollte dann auch wieder ungespeichert geschlossen werden.
Wäre schön wenn diese Möglichkeit bestehen würde.
Ich danke dir aber nochmals für deine bisherige Unterstützung!!!
Liebe Grüße
Steffi

Anzeige
AW: Fehler im String sammeln und ausgeben
03.12.2012 21:46:14
Tino
Hallo,
vielleicht so?
kommt als Code in Tabelle4 
Option Explicit 
 
Private Sub CommandButton1_Click() 
Dim lngRow& 
Dim wbImport As Workbook 
Dim ImportDatei$, sFehler$, sMAAktuell$, sFile$ 
 
Application.ScreenUpdating = False 
With Tabelle4 
For lngRow = 7 To 11 
    If .Cells(lngRow, 3) = "Ja" Then 
        sFile = .Cells(lngRow, 2).Value 
        If .Cells(lngRow, 2).Hyperlinks.Count > 0 Then 
             
            ImportDatei = Check_Link_Path(.Cells(lngRow, 2).Hyperlinks(1).Address) 
        End If 
        If ImportDatei <> "" Then 
            If Not (ImportDatei Like "*.xls" Or ImportDatei Like "*.xlsx" Or ImportDatei Like "*.xlsm") Then 
                ImportDatei = "" 
            End If 
        End If 
        If ImportDatei <> "" Then 
            Set wbImport = Workbooks.Open(ImportDatei) 
            If CheckTabelle(wbImport, "MA-Daten") Then 
                wbImport.Worksheets("MA-Daten").Range("C1, C3, C5, C7, C9, C11, C13, C15, C17, C19, C21, C23").Copy 
                    If wbImport.Sheets("MA-Daten").Range("B7").Value = "MA1" Then 
                        ThisWorkbook.Sheets("MA-Daten").Range("E17").PasteSpecial Paste:=xlValues 
                        ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA2" Then 
                        ThisWorkbook.Sheets("MA-Daten").Range("E29").PasteSpecial Paste:=xlValues 
                        ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA3" Then 
                        ThisWorkbook.Sheets("MA-Daten").Range("E41").PasteSpecial Paste:=xlValues 
                        ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA4" Then 
                        ThisWorkbook.Sheets("MA-Daten").Range("E53").PasteSpecial Paste:=xlValues 
                        ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA5" Then 
                        ThisWorkbook.Sheets("MA-Daten").Range("E65").PasteSpecial Paste:=xlValues 
                    End If 
     
                wbImport.Worksheets("MA-Daten").Range("H2, K2, N2, Q2, T2, W2, Z2, AC2, AF2, AI2, AL2, AO2, AR2, " & _
                    "AU2, AX2, BA2, BD2, BG2, BJ2, BM2, BP2, BS2, BV2, BY2, CB2, CE2, CH2, CK2, CN2, CQ2, CT2, CW2, CZ2, DC2, DF2, DI2, DL2, DO2").Copy 
                    If wbImport.Sheets("MA-Daten").Range("B7").Value = "MA1" Then 
                        ThisWorkbook.Sheets("MA-Daten").Range("G17").PasteSpecial Paste:=xlValues 
                        ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA2" Then 
                        ThisWorkbook.Sheets("MA-Daten").Range("G29").PasteSpecial Paste:=xlValues 
                        ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA3" Then 
                        ThisWorkbook.Sheets("MA-Daten").Range("G41").PasteSpecial Paste:=xlValues 
                        ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA4" Then 
                        ThisWorkbook.Sheets("MA-Daten").Range("G53").PasteSpecial Paste:=xlValues 
                        ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA5" Then 
                        ThisWorkbook.Sheets("MA-Daten").Range("G65").PasteSpecial Paste:=xlValues 
                    End If 
     
                wbImport.Worksheets("MA-Daten").Range("H3, K3, N3, Q3, T3, W3, Z3, AC3, AF3, AI3, AL3, AO3, AR3, AU3, " & _
                    "AX3, BA3, BD3, BG3, BJ3, BM3, BP3, BS3, BV3, BY3, CB3, CE3, CH3, CK3, CN3, CQ3, CT3, CW3, CZ3, DC3, DF3, DI3, DL3, DO3").Copy 
                    If wbImport.Sheets("MA-Daten").Range("B7").Value = "MA1" Then 
                        ThisWorkbook.Sheets("MA-Daten").Range("G78").PasteSpecial Paste:=xlValues 
                        ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA2" Then 
                        ThisWorkbook.Sheets("MA-Daten").Range("G90").PasteSpecial Paste:=xlValues 
                        ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA3" Then 
                        ThisWorkbook.Sheets("MA-Daten").Range("G102").PasteSpecial Paste:=xlValues 
                        ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA4" Then 
                        ThisWorkbook.Sheets("MA-Daten").Range("G114").PasteSpecial Paste:=xlValues 
                        ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA5" Then 
                        ThisWorkbook.Sheets("MA-Daten").Range("G126").PasteSpecial Paste:=xlValues 
                    End If 
     
                wbImport.Worksheets("MA-Daten").Range("H5, K5, N5, Q5, T5, W5, Z5, AC5, AF5, AI5, AL5, AO5, AR5, AU5, AX5, " & _
                    "BA5, BD5, BG5, BJ5, BM5, BP5, BS5, BV5, BY5, CB5, CE5, CH5, CK5, CN5, CQ5, CT5, CW5, CZ5, DC5, DF5, DI5, DL5, DO5").Copy 
                    If wbImport.Sheets("MA-Daten").Range("B7").Value = "MA1" Then 
                        ThisWorkbook.Sheets("MA-Daten").Range("G18").PasteSpecial Paste:=xlValues 
                        ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA2" Then 
                        ThisWorkbook.Sheets("MA-Daten").Range("G30").PasteSpecial Paste:=xlValues 
                        ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA3" Then 
                        ThisWorkbook.Sheets("MA-Daten").Range("G42").PasteSpecial Paste:=xlValues 
                        ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA4" Then 
                        ThisWorkbook.Sheets("MA-Daten").Range("G54").PasteSpecial Paste:=xlValues 
                        ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA5" Then 
                        ThisWorkbook.Sheets("MA-Daten").Range("G66").PasteSpecial Paste:=xlValues 
                    End If 
     
                wbImport.Worksheets("MA-Daten").Range("H6, K6, N6, Q6, T6, W6, Z6, AC6, AF6, AI6, AL6, AO6, AR6, AU6, AX6, " & _
                    "BA6, BD6, BG6, BJ6, BM6, BP6, BS6, BV6, BY6, CB6, CE6, CH6, CK6, CN6, CQ6, CT6, CW6, CZ6, DC6, DF6, DI6, DL6, DO6").Copy 
                    If wbImport.Sheets("MA-Daten").Range("B7").Value = "MA1" Then 
                        ThisWorkbook.Sheets("MA-Daten").Range("G79").PasteSpecial Paste:=xlValues 
                        ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA2" Then 
                        ThisWorkbook.Sheets("MA-Daten").Range("G91").PasteSpecial Paste:=xlValues 
                        ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA3" Then 
                        ThisWorkbook.Sheets("MA-Daten").Range("G103").PasteSpecial Paste:=xlValues 
                        ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA4" Then 
                        ThisWorkbook.Sheets("MA-Daten").Range("G115").PasteSpecial Paste:=xlValues 
                        ElseIf wbImport.Sheets("MA-Daten").Range("B7").Value = "MA5" Then 
                        ThisWorkbook.Sheets("MA-Daten").Range("G127").PasteSpecial Paste:=xlValues 
                    End If 
     
                sMAAktuell = sMAAktuell & Worksheets("Tabelle1").Cells(lngRow, 1) & vbCr 
                wbImport.Close savechanges:=False 
                Application.CutCopyMode = False 
            Else 'CheckTabelle Fehler 
                sFehler = sFehler & .Cells(lngRow, 1) & " - " & sFile & " - keine Tabelle MA-Daten" & vbCr 
                wbImport.Close False 
                Set wbImport = Nothing 
            End If 
        Else 'keine Datei oder Excel-File 
            sFehler = sFehler & .Cells(lngRow, 1) & " - " & sFile & " - Datei fehlt oder kein Excel-File" & vbCr 
        End If 
         
        sFile = "" 
        ImportDatei = "" 
    End If 
Next lngRow 
End With 
     
If sMAAktuell <> "" Then 
    sMAAktuell = Left$(sMAAktuell, Len(sMAAktuell) - 1) 
    MsgBox "Folgende MA-Daten wurden aktualisiert:" & vbCr & vbCr & sMAAktuell 
End If 
Application.ScreenUpdating = True 
     
If sFehler <> "" Then 
    MsgBox "Bitte überprüfen Sie die Daten!" & vbCr & vbCr & Left$(sFehler, Len(sFehler) - 1), vbExclamation, "Fehler in Hyperlink" 
    ThisWorkbook.Worksheets("Tabelle1").Activate 
End If 
End Sub
kommt als Code in Modul1 
Option Explicit 
 
Private Declare Function GetFullPathName Lib "kernel32.dll" Alias _
"GetFullPathNameA" (ByVal lpFileName As String, ByVal nBufferLength As Long, _
ByVal lpBuffer As String, ByVal lpFilePart As String) As Long 
 
 
Public Function GetRelativePath(PathTo As String) As String 
  Dim pszPath As String 
  Const MAX_PATH = 255 
  pszPath = Space(MAX_PATH) 
  'API-Funktion aufrufen 
  GetFullPathName PathTo, MAX_PATH, pszPath, vbNullString 
  'Rückgabe des relativierten Pfads 
  GetRelativePath = Left$(pszPath, InStr(pszPath, Chr(0)) - 1) 
End Function 
 
 
Function Check_Link_Path(strLinkPath$) As String 
Dim sFullPath$ 
On Error Resume Next 
ChDrive ThisWorkbook.Path 
ChDir ThisWorkbook.Path 
sFullPath = GetRelativePath(strLinkPath) 
ChDrive strLinkPath 
ChDir Left$(sFullPath, InStrRev(sFullPath, "\")) 
If Dir(sFullPath, vbNormal) <> "" Then 
    Check_Link_Path = sFullPath 
End If 
End Function 
 
Function CheckTabelle(oWB As Workbook, strTabName$) As Boolean 
On Error Resume Next 
CheckTabelle = oWB.Sheets(strTabName).Index <> 0 
End Function
Gruß Tino

Anzeige
AW: Fehler im String sammeln und ausgeben
03.12.2012 22:54:33
Steffi
Hallo Tino,
du bist spitze!!!
Jetzt funktioniert es so wie ich das möchte :).
Ich DANKE dir herzlichst für deine Geduld und kompetente Unterstützung!!!
Grüßle
Steffi

302 Forumthreads zu ähnlichen Themen

Einzigartige Werte in Array identifizieren
Sebastian

Hallo Experten,
ich habe eine Frage, die vermutlich recht leicht zu lösen sein sollte:
Ich habe eine sehr lange Liste, in der in Spalte A Produktnummern stehen, viele kommen auch mehrfach vor. Ich möchte gerne daraus in einem neuen Tabellenblatt eine Liste erstellen, in der jede verschi...
10.08.2008 21:30:00
Thread-ID: 1000688
2 Beiträge
Anzeige
Formel über VBA in Range.
Tom

Hi,
ich Versuch eine Summenformel
=SUMME(A3:A29)
verzweifelt über VBA dynamisch einzutragen.
Die Summe muss von A bis J eingetragen werden. Jedesmal mit dem entpsrechenden Buchstaben nicht immer mit A.
Hab das so versucht:
For k = 2 To 10 'Range(Cells(k, 29), Cells(...
13.08.2008 11:41:00
Thread-ID: 1001455
4 Beiträge
If...Then... bei verschiedenen Bedingungen?
Vic

Hallo zusammen
Ich habe folgendes Problem und weiss nicht, wie ich das über mein Marko gelöst bekomme:
In der Spalte "H" habe ich diverse Werte (zwischen 0 und X) und in der Spalte "K" ebenfalls. Nun möchte ich, dass es in der Spalte "L" eine "0" ausgibt, wenn "H" den Wert Null hat und...
13.08.2008 15:00:00
Thread-ID: 1001553
5 Beiträge
Anzeige
Schriftgröße Zelle automatisch an Inhalt anpassen
Peter

Hallo Leute!
Folgende Situation: ich habe in einer Arbeitsmappe auf mehreren Tabellenblättern zu oberst das gleiche Design. Unter anderem steht auf jedem Blatt oben in einer Zelle die gleiche Information. Aus Gründen der Einfachheit muss man diese Information nur einmal auf dem ersten Tabel...
21.08.2008 15:04:06
Thread-ID: 1003519
4 Beiträge
Wert finden und nicht Ziffer
baronf


Habe ein Problem,
in der Spalte C soll nach Zahlen gesucht werden (Variable MZ)
Wenn MZ den Wert 1 bekommt, wird dür MZ ein wahrer Wert ausgegeben, wenn die Zahl auftriit.
Das heisst, dass nach der Ziffer und nicht nach der Zahl gesucht wird!
Wie kann ich die Formel ändern,...
28.08.2008 16:05:00
Thread-ID: 1005503
2 Beiträge
Wert finden und nicht Ziffer
baronf


Habe ein Problem,
in der Spalte C soll nach Zahlen gesucht werden (Variable MZ)
Wenn MZ den Wert 1 bekommt, wird dür MZ ein wahrer Wert ausgegeben, wenn die Zahl auftriit.
Das heisst, dass nach der Ziffer und nicht nach der Zahl gesucht wird!
Wie kann ich die Formel ändern,...
28.08.2008 16:06:00
Thread-ID: 1005504
4 Beiträge
Knifflig - Zeilen einfügen
Frederic

Guten Morgen liebes Forum,
ich hab da ein kleines kniffeliges Problem, hoffe, ihr könnt mir evtl. weiterhelfen:
Ich exportiere Daten per Makro in eine neue leere Mappe (Mappe1.xls).
Vorab: Die Spaltenzuordnung ist immer identisch!
Jetzt möchte ich statt manuell wie bisher, die R...
29.08.2008 07:29:19
Thread-ID: 1005628
10 Beiträge
Range bis zu einer bstimmten Zeile kopieren
Joachim

Hi,
ich habe eine Sub, um Daten eines Ranges von einem Tabellenblatt zu einem andren Tabellenblatt zu kopieren:
Sub Kopieren() Dim intS As Integer Sheets("Daten einlesen").Range("C2:H150").Copy With Sheets("Übersicht") intS = .Cells(4, Columns.Count).End(xlToLeft).Column .Cells(5, in...
19.09.2008 20:57:12
Thread-ID: 1011139
5 Beiträge
Anzeige

Links zu Excel-Dialogen

CommandButton

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen
Forumthread
Beiträge
1
2
3
4
4
3
1
3
9
4
3
9
7
5
1
6
3
6
13
2
3
3
6
20
1