Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

Werte in Matrix einfügen- Schleife

Frage Microsoft Microsoft Office

Mitglied: Ikaner

Ikaner (Level 1) - Jetzt verbinden

04.10.2014 um 12:15 Uhr, 1014 Aufrufe, 6 Kommentare

Hallo Leute,

wie kann ich das bestehende Makro ergänzen, sodass es mir für jedes entstandene Arbeitsblatt (trägt den Namen der Quelldatei z.B. "P20I30" den Wert in der Zelle J2 in eine andere Arbeitsmappe genannt "Matrix" in die jeweils passende Zelle einfügt? (ohne Formel nur den Wert)

6cc5f3052180ec78515386213eaf4748 - Klicke auf das Bild, um es zu vergrößern

Hier im Bild beispielweise entspricht die Zelle L10 => P8I10

Ich will nicht jeder Zelle einen Namen geben, weil diese Matrix noch lange nicht vollständig ist. (bis zu 255 Zeilen/255 Spalten), daher müsste der Code "mitdenken" können, wenn ich die Zeilen und Spalten erweitere.

01.
Sub ImportCSVData() 
02.
    Dim wb As Workbook, wbCSV As Workbook, wsRohdaten As Worksheet, wsDiagramm As Worksheet 
03.
    Set fso = CreateObject("Scripting.FileSystemObject") 
04.
     
05.
    ' Pfad zu den CSV-Dateien angeben (ohne Backslash am Ende) 
06.
    '-------------------------------------- 
07.
    Const strPathCSV = "Datei_Pfad" 'Pfad, wo die Rohdaten hinterlegt sind 
08.
    Const strCSVExtension = "*.csv" 
09.
    '-------------------------------------- 
10.
    'Diagramm-Vorlagesheet 
11.
    Set wsDiagrammVorlage = Sheets("Diagramm_Vorlage") 
12.
     
13.
    'CSV-Dateien im Verzeichnis holen 
14.
    strFilename = Dir(strPathCSV & "\" & strCSVExtension) 
15.
     
16.
    'ScreenRefresh während des Importes abschalten 
17.
    Application.ScreenUpdating = False 
18.
    Application.DisplayAlerts = False 
19.
     
20.
    'Diese Schleife für jede CSV-Datei im Verzeichnis ausführen 
21.
    While strFilename <> "" 
22.
        strBasename = fso.GetBaseName(strFilename) 
23.
        'Neues Diagramm-Sheet auf Basis der Vorlage erstellen 
24.
        wsDiagrammVorlage.Copy After:=Sheets(Sheets.Count) 
25.
        Set wsDiagramm = Sheets(Sheets.Count) 
26.
         
27.
        'Datenquelle des Charts auf das aktuelle Arbeitsblatt aktualisieren 
28.
        wsDiagramm.ChartObjects(1).Chart.SetSourceData wsDiagramm.Range("$B$1:$H$2086") 
29.
         
30.
        On Error Resume Next 
31.
        'Namen des neuen Diagramm-Sheets auf den Namen der CSV-Datei (ohne Dateierweiterung) setzen 
32.
        wsDiagramm.Name = strBasename 
33.
        'Falls schon ein Sheet mit dem selben Namen existiert gebe eine Meldung aus. 
34.
        If Err.Number <> 0 Then 
35.
            MsgBox "Ein Diagramm mit dem Namen " & fso.GetBaseName(strFilename) & " existiert bereits in der Arbeitsmappe!", vbExclamation, "Fehler" 
36.
        End If 
37.
        'Fehlerbehandlung zurücksetzen 
38.
        On Error GoTo 0 
39.
         
40.
        'CSV-Datei öffnen und Daten anpassen und importieren 
41.
        Set wbCSV = Workbooks.Open(Filename:=strPathCSV & "\" & strFilename, Local:=True, Format:=4) 
42.
        With wbCSV.Sheets(1) 
43.
            'nicht benötigte Zeilen aus den Rohdaten entfernen (unverändert nach deiner Vorgabe) 
44.
            lngSoll = Application.WorksheetFunction.Match(60, .Columns(3), 0) - 20 
45.
            If lngSoll > 0 Then 
46.
                .Rows("1:" & lngSoll).Delete 
47.
                'Daten in das Diagramm-Sheet übertragen 
48.
                .Range("B1:C" & .UsedRange.Rows.Count).Copy wsDiagramm.Range("C2") 
49.
            Else 
50.
                'wenn durch die Bedingung nichts gelöscht wurde importiere den gesamten Bereich ab Zelle B6:CXXXX 
51.
                .Range("B6:C" & .UsedRange.Rows.Count).Copy wsDiagramm.Range("C2") 
52.
            End If 
53.
             
54.
            'CSV schließen ohne Änderungen zu speichern 
55.
            wbCSV.Close False 
56.
        End With 
57.
         
58.
        'nächste CSV-Datei holen 
59.
        strFilename = Dir 
60.
    Wend 
61.
    'Screen wieder aktualisieren 
62.
    Application.ScreenUpdating = True 
63.
    Application.DisplayAlerts = True 
64.
     
65.
    'Objekte freigeben 
66.
    Set fso = Nothing 
67.
End Sub
P.S. den Code habe ich nicht selber geschrieben, da war ein sehr schlauer Kopf dran ^^
Mitglied: colinardo
04.10.2014, aktualisiert um 13:45 Uhr
Moin Patrik,
guckst du hier:
01.
Sub ImportCSVData() 
02.
    Dim wb As Workbook, wbCSV As Workbook, wsRohdaten As Worksheet, wsDiagramm As Worksheet, wsMatrix As Worksheet, row_y As Integer, col_x As Integer 
03.
    Set fso = CreateObject("Scripting.FileSystemObject") 
04.
     
05.
    ' Pfad zu den CSV-Dateien angeben (ohne Backslash am Ende) 
06.
    '-------------------------------------- 
07.
    Const strPathCSV = "D:\Pfad" 
08.
    Const strCSVExtension = "*.csv" 
09.
    '-------------------------------------- 
10.
    'Diagramm-Vorlagesheet 
11.
    Set wsDiagrammVorlage = Sheets("Diagramm_Vorlage") 
12.
    'Matrix  Sheet 
13.
    Set wsMatrix = Sheets("Matrix") 
14.
     
15.
    'CSV-Dateien im Verzeichnis holen 
16.
    strFilename = Dir(strPathCSV & "\" & strCSVExtension) 
17.
     
18.
    'ScreenRefresh während des Importes abschalten 
19.
    Application.ScreenUpdating = False 
20.
    Application.DisplayAlerts = False 
21.
     
22.
    'Diese Schleife für jede CSV-Datei im Verzeichnis ausführen 
23.
    While strFilename <> "" 
24.
        strBasename = fso.GetBaseName(strFilename) 
25.
        'Koordinaten für Matrix extrahieren 
26.
        arrCords = Split(strBasename, "I", -1, vbTextCompare) 
27.
        row_y = Application.WorksheetFunction.Match(arrCords(0), wsMatrix.Range("B:B"), 0) 
28.
        col_x = Application.WorksheetFunction.Match("I" & arrCords(1), wsMatrix.Range("2:2"), 0) 
29.
         
30.
        'Neues Diagramm-Sheet auf Basis der Vorlage erstellen 
31.
        wsDiagrammVorlage.Copy After:=Sheets(Sheets.Count) 
32.
        Set wsDiagramm = Sheets(Sheets.Count) 
33.
         
34.
        'Datenquelle des Charts auf das aktuelle Arbeitsblatt aktualisieren 
35.
        wsDiagramm.ChartObjects(1).Chart.SetSourceData wsDiagramm.Range("$B$1:$H$2086") 
36.
         
37.
        On Error Resume Next 
38.
        'Namen des neuen Diagramm-Sheets auf den Namen der CSV-Datei (ohne Dateierweiterung) setzen 
39.
        wsDiagramm.Name = strBasename 
40.
        'Falls schon ein Sheet mit dem selben Namen existiert gebe eine Meldung aus. 
41.
        If Err.Number <> 0 Then 
42.
            MsgBox "Ein Diagramm mit dem Namen " & fso.GetBaseName(strFilename) & " existiert bereits in der Arbeitsmappe!", vbExclamation, "Fehler" 
43.
        End If 
44.
        'Fehlerbehandlung zurücksetzen 
45.
        On Error GoTo 0 
46.
         
47.
        'CSV-Datei öffnen und Daten anpassen und importieren 
48.
        Set wbCSV = Workbooks.Open(Filename:=strPathCSV & "\" & strFilename, Local:=True, Format:=4) 
49.
        With wbCSV.Sheets(1) 
50.
            'nicht benötigte Zeilen aus den Rohdaten entfernen (unverändert nach deiner Vorgabe) 
51.
            lngSoll = Application.WorksheetFunction.Match(60, .Columns(3), 0) - 20 
52.
            If lngSoll > 0 Then 
53.
                .Rows("1:" & lngSoll).Delete 
54.
                'Daten in das Diagramm-Sheet übertragen 
55.
                .Range("B1:C" & .UsedRange.Rows.Count).Copy wsDiagramm.Range("C2") 
56.
            Else 
57.
                'wenn durch die Bedingung nichts gelöscht wurde importiere den gesamten Bereich ab Zelle B6:CXXXX 
58.
                .Range("B6:C" & .UsedRange.Rows.Count).Copy wsDiagramm.Range("C2") 
59.
            End If 
60.
            'Gesamtwert in die Matrix eintragen 
61.
            wsMatrix.Cells(row_y, col_x).Value = wsDiagramm.Range("J2").Value 
62.
            'CSV schließen ohne Änderungen zu speichern 
63.
            wbCSV.Close False 
64.
        End With 
65.
         
66.
        'nächste CSV-Datei holen 
67.
        strFilename = Dir 
68.
    Wend 
69.
    'Screen wieder aktualisieren 
70.
    Application.ScreenUpdating = True 
71.
    Application.DisplayAlerts = True 
72.
     
73.
    'Objekte freigeben 
74.
    Set fso = Nothing 
75.
End Sub
Grüße Uwe
Bitte warten ..
Mitglied: Ikaner
04.10.2014 um 13:46 Uhr
Hallo Uwe,

jetzt hab ich dich extra nicht angeschrieben, um dir nicht auf die Nerven zu gehen. =D

und zack hab ich ne Antwort - danke
Bitte warten ..
Mitglied: colinardo
04.10.2014, aktualisiert um 13:51 Uhr
Zitat von Ikaner:
jetzt hab ich dich extra nicht angeschrieben, um dir nicht auf die Nerven zu gehen. =D
und zack hab ich ne Antwort - danke
kam gerade hier vorbei, und dachte das machen wir schnell, so braucht sich niemand erst in den Code einlesen

Grüße Uwe
Bitte warten ..
Mitglied: Ikaner
04.10.2014 um 14:15 Uhr
Achso ok

Es funktioniert einwandfrei.

muss ich im Code noch was ändern, wenn mehr Zellen und Spalten hinzu kommen? bzw. macht das dem Code was aus, wenn Zellen ausgeblendet sind?

Grüße Patrick
Bitte warten ..
Mitglied: colinardo
04.10.2014, aktualisiert um 14:19 Uhr
Zitat von Ikaner:
muss ich im Code noch was ändern, wenn mehr Zellen und Spalten hinzu kommen? bzw. macht das dem Code was aus, wenn Zellen
ausgeblendet sind?
nein geht out-of-the-box, nur die Spalte (B) und Zeile(2) in denen die Koordinaten stehen (Zeile 27/28 im Code) musst du ändern wenn du die Matrix woanders auf dem Sheet platzieren willst.
Bitte warten ..
Mitglied: Ikaner
04.10.2014 um 14:25 Uhr
Alles klar. danke dir
Bitte warten ..
Neuester Wissensbeitrag
Microsoft

Lizenzwiederverkauf und seine Tücken

(5)

Erfahrungsbericht von DerWoWusste zum Thema Microsoft ...

Ähnliche Inhalte
Datenbanken
Mit sql eine Zeile einfügen, select und feste Werte (9)

Frage von helmuthelmut2000 zum Thema Datenbanken ...

Microsoft Office
gelöst Wie kann man die Standard-Schriftart bei einfügen von Text in Word 2013 festlegen? (3)

Frage von Rene1976 zum Thema Microsoft Office ...

Netzwerkmanagement
gelöst Icingaweb2 Werte für das NRPE CheckDisk anpassen (8)

Frage von M.Marz zum Thema Netzwerkmanagement ...

Batch & Shell
Schleife mit todos CMD

Frage von TommyDerWalker zum Thema Batch & Shell ...

Heiß diskutierte Inhalte
Windows Netzwerk
Windows 10 RDP geht nicht (16)

Frage von Fiasko zum Thema Windows Netzwerk ...

Windows Server
Outlook Verbindungsversuch mit Exchange (15)

Frage von xbast1x zum Thema Windows Server ...

Microsoft Office
Keine Updates für Office 2016 (13)

Frage von Motte990 zum Thema Microsoft Office ...