Collapse column

Beiträge anzeigen

Diese Sektion erlaubt es dir alle Beiträge dieses Mitglieds zu sehen. Beachte, dass du nur solche Beiträge sehen kannst, zu denen du auch Zugriffsrechte hast.


Nachrichten - lklk

Seiten: [1]
1
Excel / Antw:Office 2010: Geschwindigkeit Makro
« am: Juli 21, 2016, 13:31:56 Nachmittag »
*50 Werte Spaltenwerte und insgesamt 300 Zeilen!  nicht Spalten, sorry

2
Excel / Office 2010: Geschwindigkeit Makro
« am: Juli 21, 2016, 13:29:55 Nachmittag »
Hallo Leute,

gibt es denn weitere Möglickeiten, dass mein Makro schneller läuft? Folgendes habe ich schon eingebaut:

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With


Mein Makro öffnet ca. 300 Excel Files kopiert eine Spalte (ca.50 Werte) und transponiert diese und fügt sie in ein Excel File untereinander. Spricht 50 Werte in einer Zeile und 300 Spalten insgesamt am Ende.

 Für diese 300 Datein werden momentan 30 min benötigt.
Kann ich hier noch etwas ändern, damit ich einen deutlichen Unterschied bekomme oder ist das "normal"?

Habe bei meinen Codes auch auf folgendes geachtet: https://de.wikibooks.org/wiki/VBA_in_Excel/_Code-Optimierung

Danke für die Auskunft :)

3
Excel / Ordner auslesen
« am: Juli 13, 2016, 10:02:29 Vormittag »
Moin moin :),

ich habe eine Beispieldatei mit im Anhang.
Auf Tabellenblatt2 befindet sich das Layout meiner einzulesenden Datei. Sie ist bei jeder Datei im Ordner (Pfad z.b. "C:\") gleich und soll alle Werte, die sie beinhaltet einlesen (Zeilenanzahl kann variieren, es sollen alle ausgefüllten Zellen eingefügt warden)
So wie im Beispiel sollen alle Datein untereinander eingefügt werden, welche sich im Ordner befinden.

Also alle Werte der:
Datei 1 mit Datum 13.07.2016
Datei 2 mit Datum 14.07.2016
usw.


Danke für eure Hilfe

4
Excel / Makro mit bestimmter Reihenfolge
« am: Juni 30, 2016, 09:11:04 Vormittag »
Guten Morgen,

ich habe ein Makros geschrieben, um bestimmte Messergebnisse auszuwerten. Allerdings habe ich während des Einsatzes festgestellt, dass es Probleme gibt, sobald die einzulesende Datei eine Zeile zu wenig hat.
Zur Veranschauung einer Messwertangabe:

In den Zeilen (1) steht, was gemessen wurde: z.B. Außendurchmesser
In der Spalte (A) steht das dazugehörige Ergebnis: z.B 0,5

Mein Makros nimmt jetzt diese Werte und kopiert sie. Sobald jetzt aber im einzulesenden Dokument eine Zeile anders ist/fehlt, dann rückt mir das Makros alle Ergebnisse eine Spalte nach links im Excel file.

Hier ein Ausschnitt meines Codes:

Sub Merge_CMM_Files(Source_Folder, SuchString, TableName As String)


    Dim objFileSearch As clsFileSearch
    Dim lngIndex As Long
    Dim lngcount As Long
    Dim dataSets As Variant
   
   
   
       
    Set objFileSearch = New clsFileSearch
    With objFileSearch
        .CaseSenstiv = True
        .Extension = "*.xls"
        .FolderPath = Source_Folder
        .SearchLike = SuchString
        .SubFolders = True
   
       

                If .Execute(Sort_by_name, Sort_Order_Ascending) > 0 Then  'Gefunden!
                   
                    'Anzeige wie viele Datein gefunden wurden
                    If MsgBox("Es wurden " & .FileCount & " Dateien gefunden. Wollen sie diese Dateien mergen?", vbYesNo, "Mehrfach-Fund   = vbYes Then
                        dataSets = .FileCount
                        Application.EnableEvents = False
                        Sheets.Add
                        Application.EnableEvents = True
                        Sheets.Item(1).Name = TableName
                       
                       
                       'Merkmalsbeschreibungen aus erster Datei laden
                        Application.EnableEvents = False    'Startmakros in den Datendateien blockieren
                        Workbooks.Open Filename:=.Files(1).strPath
                        Application.EnableEvents = True     'Makros aktivieren
                                 
                       

                        ActiveWindow.Close Savechanges:=False
                       
                       
                        For lngcount = 1 To .FileCount 'routine für datei öffnen, daten kopieren, datei schliessen.
                       
                       
                                ' Einzelne Datei öffnen
                                Application.EnableEvents = False    'Startmakros in den Datendateien blockieren
                               
                                Workbooks.Open Filename:=.Files(lngcount).strPath
                                Application.EnableEvents = True     'Makros aktivieren
                               
                                'Kopfdaten kopieren
                                'Measurementplan
                                Windows(Dir(.Files(lngcount).strPath, vbDirectory)).Activate
                                Range("B4").Select
                                Application.CutCopyMode = False
                                Selection.Copy
                                Windows("Merge_CMM.xls").Activate
                                Cells(1, 1).Select
                                ActiveSheet.Paste
                               
                                'Operator
                                Windows(Dir(.Files(lngcount).strPath, vbDirectory)).Activate
                                Range("B10").Select
                                Application.CutCopyMode = False
                                Selection.Copy
                                Windows("Merge_CMM.xls").Activate
                                Cells(1, 2).Select
                                ActiveSheet.Paste
                               
                                'Date
                                Windows(Dir(.Files(lngcount).strPath, vbDirectory)).Activate
                                Range("D4").Select
                                Application.CutCopyMode = False
                                Selection.Copy
                                Windows("Merge_CMM.xls").Activate
                                Cells(1, 3).Select
                                ActiveSheet.Paste
                               
                               
                                'Time
                                Windows(Dir(.Files(lngcount).strPath, vbDirectory)).Activate
                                Range("D7").Select
                                Application.CutCopyMode = False
                                Selection.Copy
                                Windows("Merge_CMM.xls").Activate
                                Cells(1, 4).Select
                                ActiveSheet.Paste
                               
                                'Order
                                Windows(Dir(.Files(lngcount).strPath, vbDirectory)).Activate
                                Range("F4").Select
                                Application.CutCopyMode = False
                                Selection.Copy
                                Windows("Merge_CMM.xls").Activate
                                Cells(1, 5).Select
                                ActiveSheet.Paste
                               
                                'Part No
                                Windows(Dir(.Files(lngcount).strPath, vbDirectory)).Activate
                                Range("F7").Select
                                Application.CutCopyMode = False
                                Selection.Copy
                                Windows("Merge_CMM.xls").Activate
                                Cells(1, 6).Select
                                ActiveSheet.Paste
                               
                                'Ebh_Z_PF BezB
                                Windows(Dir(.Files(lngcount).strPath, vbDirectory)).Activate
                                Range("A14").Select
                                Application.CutCopyMode = False
                                Selection.Copy
                                Windows("Merge_CMM.xls").Activate
                                Cells(1, 7).Select
                                ActiveSheet.Paste
                               
                                'F3 Ø 242j6 BezC
                                Windows(Dir(.Files(lngcount).strPath, vbDirectory)).Activate
                                Range("A15").Select
                                Application.CutCopyMode = False
                                Selection.Copy
                                Windows("Merge_CMM.xls").Activate
                                Cells(1, 8).Select
                                ActiveSheet.Paste
                               
                                'Rdht_Z_ø242j6_BezC
                                Windows(Dir(.Files(lngcount).strPath, vbDirectory)).Activate
                                Range("A16").Select
                                Application.CutCopyMode = False
                                Selection.Copy
                                Windows("Merge_CMM.xls").Activate
                                Cells(1, 9).Select
                                ActiveSheet.Paste
                               
                                'Rdlf_ø242j6_BezC zu A
                                Windows(Dir(.Files(lngcount).strPath, vbDirectory)).Activate
                                Range("A17").Select
                                Application.CutCopyMode = False
                                Selection.Copy
                                Windows("Merge_CMM.xls").Activate
                                Cells(1, 10).Select
                                ActiveSheet.Paste
                               
                               


                                 
                                 
                                'Measurement Plan kopieren
                                Windows(Dir(.Files(lngcount).strPath, vbDirectory)).Activate
                                Range("B5").Select
                                Application.CutCopyMode = False
                                Selection.Copy
                                Windows("Merge_CMM.xls").Activate
                                Cells(2 + lngcount, 1).Select
                                ActiveSheet.Paste
                               
                                'Operator kopieren
                                Windows(Dir(.Files(lngcount).strPath, vbDirectory)).Activate
                                Range("B11").Select
                                Application.CutCopyMode = False
                                Selection.Copy
                                Windows("Merge_CMM.xls").Activate
                                Cells(2 + lngcount, 2).Select
                                ActiveSheet.Paste
                               
                                'Date kopieren
                                Windows(Dir(.Files(lngcount).strPath, vbDirectory)).Activate
                                Range("D5").Select
                                Application.CutCopyMode = False
                                Selection.Copy
                                Windows("Merge_CMM.xls").Activate
                                Cells(2 + lngcount, 3).Select
                                ActiveSheet.Paste
                               
                               
                               
                               
                                'Time kopieren
                                Windows(Dir(.Files(lngcount).strPath, vbDirectory)).Activate
                                Range("D8").Select
                                Application.CutCopyMode = False
                                Selection.Copy
                                Windows("Merge_CMM.xls").Activate
                                Cells(2 + lngcount, 4).Select
                                ActiveSheet.Paste
                               
                                'Order kopieren
                                Windows(Dir(.Files(lngcount).strPath, vbDirectory)).Activate
                                Range("F5").Select
                                Application.CutCopyMode = False
                                Selection.Copy
                                Windows("Merge_CMM.xls").Activate
                                Cells(2 + lngcount, 5).Select
                                ActiveSheet.Paste
                               
                                'Part No. kopieren
                                Windows(Dir(.Files(lngcount).strPath, vbDirectory)).Activate
                                Range("F8").Select
                                Application.CutCopyMode = False
                                Selection.Copy
                                Windows("Merge_CMM.xls").Activate
                                Cells(2 + lngcount, 6).Select
                                ActiveSheet.Paste
                               
                                'Ebh_Z_PF BezB kopieren
                                Windows(Dir(.Files(lngcount).strPath, vbDirectory)).Activate
                                Range("B14").Select
                                Application.CutCopyMode = False
                                Selection.Copy
                                Windows("Merge_CMM.xls").Activate
                                Cells(2 + lngcount, 7).Select
                                ActiveSheet.Paste
                               
                                'F3 Ø 242j6 BezC
                                Windows(Dir(.Files(lngcount).strPath, vbDirectory)).Activate
                                Range("B15").Select
                                Application.CutCopyMode = False
                                Selection.Copy
                                Windows("Merge_CMM.xls").Activate
                                Cells(2 + lngcount, 8).Select
                                ActiveSheet.Paste
                               
                                'Rdht_Z_ø242j6_BezC kopieren
                                Windows(Dir(.Files(lngcount).strPath, vbDirectory)).Activate
                                Range("B16").Select
                                Application.CutCopyMode = False
                                Selection.Copy
                                Windows("Merge_CMM.xls").Activate
                                Cells(2 + lngcount, 9).Select
                                ActiveSheet.Paste
                               
                                'Rdlf_ø242j6_BezC zu A kopieren
                                Windows(Dir(.Files(lngcount).strPath, vbDirectory)).Activate
                                Range("B17").Select
                                Application.CutCopyMode = False
                                Selection.Copy
                                Windows("Merge_CMM.xls").Activate
                                Cells(2 + lngcount, 10).Select
                                ActiveSheet.Paste
                               
                                                               
                                'Datei Schliessen
                                Windows(Dir(.Files(lngcount).strPath, vbDirectory)).Activate
                                ActiveWindow.Close Savechanges:=False
                               
                           
                        Next lngcount
                 
                   
                    End If
             
                 
                End If

           
End With
Set objFileSearch = Nothing
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub



Ich hoffe mir kann jemanden weiter helfen.
Grüße
Lena

5
Excel / Antw: Office 2010: Makros - Daten aus Ordner in Excel Datei bringen
« am: Juni 24, 2016, 07:59:16 Vormittag »
Morgen  :)

Danke für die Antwort gmg-cc.
Ich habe schon Tage damit verbracht das Problem mit Mr. Goo zu lösen oder VBA Bücher, allerdings ohne Erfolg.
Habe nur sowas gefunden:

Private Function GetValue(path, file, sheet, ref)
 '   Retrieves a value from a closed workbook
     Dim arg As String

 '   Make sure the file exists
     If Right(path, 1) <> "\" Then path = path & "\"
     If Dir(path & file) = "" Then
         GetValue = "File Not Found"
         Exit Function
     End If

 '   Create the argument
     arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
       Range(ref).Range("A1").Address(, , xlR1C1)

 '   Execute an XLM macro
     GetValue = ExecuteExcel4Macro(arg)
 End Function

 Sub btnUpdate_Click()
 Dim p, f, s, a As String

 Dim gPfad As String
 Dim gDatei As String
 Dim gZelle As String
 Dim eResult As String

 gZelle = Range("X100").Value

 For i = 1 To 7
 gPfad = Cells((99 + i), 30).Value
 gDatei = Cells((99 + i), 27).Value


     p = gPfad
     f = gDatei
     s = "Summe GJ"
     a = gZelle
     
 eResult = GetValue(p, f, s, a)
 Cells((99 + i), 33).Value = eResult

 Next i
     
 End Sub

Kannst du mir sagen, was diese Funktionen genau ausführen?

6
Excel / Office 2010: Makros - Daten aus Ordner in Excel Datei bringen
« am: Juni 23, 2016, 07:39:02 Vormittag »
Hallo ihr schlauen Klöpfe :D,

ich versuch seit einigen Wochen mich mit dem Thema VBA / Makros auseinander zu setzen.
Mein Vorhaben besteht darin, mehrere Excel-Arbeitsmappen in einem Ordner im Excel Hauptdokumen zu öffnen, kopieren&einfügen und wieder zu schließen.

Ich habe erst einmal mit diesem makro angefangen:

Sub Bereich_einfügen ()
Dim pfad As String, datei As String, blatt As String, bereich As Range, zelle As Object
pfad = "D:\"
datei = "Beispiel.xlsx"
blatt = "Tabelle1"
Set bereich = Range ("A1:H300")
For Each zelle In bereich
            zelle = zelle.Address(False,False)
            ActiveSheet.Cells(zelle.Row, zelle.Column).Value = GetValue(pfad, datei, blatt, zelle)
Next zelle
End Sub

Leider wird mir der Fehler "Funktion nicht definiert" angezeigt.... Zudem brauche ich nun Hilfe, dass mir alle Datein, welche sich im Ordner befinden nacheinander ausgelesen werden.


Hoffe mir kann jemand helfen.

Liebe Grüße
Lena



Seiten: [1]

Cookies erleichtern die Bereitstellung unserer Dienste. Mit der Bestätigung erklären Sie sich mit der Verwendung von Cookies einverstanden. Learn more