Makro funzt nicht so richtig | Herbers Excel-Forum

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Informationen und Beispiele zum Thema CommandButton
Screenshot zu CommandButton	CommandButton-Seite mit Beispielarbeitsmappe aufrufen

Makro funzt nicht so richtig | Herbers Excel-Forum

Makro funzt nicht so richtig von René vom 01.02.2010 20:00:26

AW: Makro funzt nicht so richtig - von fcs am 02.02.2010 12:21:56

Betrifft: Makro funzt nicht so richtig von: René
Geschrieben am: 01.02.2010 20:00:26

Hallo liebe Excelprofis,

kann mir jemand helfen mein Abslolut Beginners Makro zu optmieren. Habe mal an den Stellen wo es nicht so ist wie ich das will Bemerkungen eingeschrieben. Vielleicht könnt ihr mir einen Tipp geben. Würde mich freuen



Private Sub CommandButton1_Click()
   Worksheets("Daten Kurzcheck roh").Visible = xlSheetVisible
   Worksheets("Daten Kurzcheck aufbereitet").Visible = xlSheetVisible
   Sheets("Daten Kurzcheck roh").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;O:\Technik\Daten.csv" _
        , Destination:=Range("A2"))
        .Name = "Daten_Kurzcheck"
        .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 = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,   _
 _
_
1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
   
    Sheets("Daten Kurzcheck roh").Select
     Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    Columns("D:D").Select
    Selection.Copy
    Sheets("Daten Kurzcheck aufbereitet").Select
    Columns("D:D").Select
    ActiveSheet.Paste
    Sheets("Daten Kurzcheck roh").Select
    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Daten Kurzcheck aufbereitet").Select
    Columns("A:A").Select
    ActiveSheet.Paste
    Range("E7").Select
    Sheets("Daten Kurzcheck aufbereitet").Select
      
   Worksheets("Daten Kurzcheck roh").Visible = xlSheetVeryHidden
   Worksheets("Daten Kurzcheck aufbereitet").Visible = xlSheetVeryHidden
                
           
                        
    Dim actRow, DSNr As Long
    
    If _
    (Worksheets("Daten Kurzcheck roh").Cells(2, 1).Value = 0) Then Scannerdaten.Hide: Exit Sub


Hier würde ich aber gern wenn in Daten Kurzcheck die Zellen leer sind das Formular  _
Scannerdaten geschlossen wird und die Prozedur ganz unten (siehe letzte Zeile im Script) mit FormularWochenbericht.Show weitermacht     
            
   Load ProgressDlg2
    ProgressDlg2.Show
 
      Dim a As Long, b As Long, c As Long
    b = Sheets("Daten Kurzcheck aufbereitet").Cells(Rows.Count, 1).End(xlUp).Row
    c = Sheets("Daten Kurzcheck").Cells(Rows.Count, 1).End(xlUp).Row + 1
    Sheets("Daten Kurzcheck aufbereitet").Rows("2:" & b).Copy
    Sheets("Daten Kurzcheck").Rows(c).Insert
    Sheets("Daten Kurzcheck aufbereitet").Rows("2:" & b).Clear
 
Hier bei der Zusammenführung der Daten aus der Tabelle DatenKurzcheck aufbereitet in die
Zieltabelle Daten Kurzcheck will ich das nur die Spalten von A bis X aus der Tabelle Daten  _
Kurzcheck aufbereitet geholt werden und die Spalten ab Spalte X in der Zieltabelle Daten Kurzcheck nicht überschrieben werden.     
   
 b = Sheets("Daten Kurzcheck Formeln").Cells(Rows.Count, 3).End(xlUp).Row
    c = Sheets("Daten Kurzcheck aufbereitet").Cells(Rows.Count, 1).End(xlUp).Row + 1
    Sheets("Daten Kurzcheck Formeln").Rows("2:" & b).Copy
    Sheets("Daten Kurzcheck aufbereitet").Rows(c).Insert
    Sheets("Daten Kurzcheck roh").Rows("2:" & b).Clear
    
     Dim strFile As String
  Dim ff As Integer
  
  strFile = "O:\Technik\Daten.csv"
  
  ff = FreeFile
  
  Open strFile For Output As #ff
  Print #ff, vbNullString
  Close #ff
    
Scannerdaten.Hide
FormularWochenbericht.Show
End Sub

Betrifft: AW: Makro funzt nicht so richtig von: fcs
Geschrieben am: 02.02.2010 12:21:56

Hallo René,

1.
Die Verzeigung machst du mit "GoTo" indem du vor der Zielzeile eine Sprungadresse einfügst oder aber du baust eine vollständige If-Konststruktion
If Bedingung Then
'Aktion
Else
'Aktion
End If

2.
dann muss du mit Range und Cells statt mit Rows arbeiten, um den Bereich auf bestimme Spalten zu begrenzen.

Gruß
Franz

Private Sub CommandButton1_Click()
   Dim a As Long, b As Long, c As Long
   Dim wksRoh As Worksheet, wksAufbereitet As Worksheet
   Dim wksCheck As Worksheet, wksCheckFormel As Worksheet
   Dim actRow, DSNr As Long
                        
   
   Set wksRoh = Worksheets("Daten Kurzcheck roh")
   Set wksAufbereitet = Worksheets("Daten Kurzcheck aufbereitet")
   Set wksCheck = Worksheets("Daten Kurzcheck")
   Set wksCheckFormel = Worksheets("Daten Kurzcheck Formeln")
   
   wksRoh.Visible = xlSheetVisible
   wksAufbereitet.Visible = xlSheetVisible
   wksRoh.Select
   With wksRoh.QueryTables.Add(Connection:= _
      "TEXT;O:\Technik\Daten.csv" _
      , Destination:=Range("A2"))
      .Name = "Daten_Kurzcheck"
      .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 = True
      .TextFileCommaDelimiter = False
      .TextFileSpaceDelimiter = False
      .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
          1, 1)
      .TextFileTrailingMinusNumbers = True
      .Refresh BackgroundQuery:=False
    End With
   
    wksRoh.Rows("1:1").Delete Shift:=xlUp
    wksRoh.Columns("D:D").Copy Destination:=wksAufbereitet.Columns("D:D")
    wksRoh.Columns("A:A").Copy Destination:=wksAufbereitet.Columns("A:A")
    wksAufbereitet.Select
      
    wksRoh.Visible = xlSheetVeryHidden
    wksAufbereitet.Visible = xlSheetVeryHidden
    
    If (wksRoh.Cells(2, 1).Value = 0) Then
        Scannerdaten.Hide
    Else
       Load ProgressDlg2
       ProgressDlg2.Show
     
        b = wksAufbereitet.Cells(Rows.Count, 1).End(xlUp).Row
        c = wksCheck.Cells(Rows.Count, 1).End(xlUp).Row + 1
        
        With wksAufbereitet
          .Range(.Cells(2, 1), .Cells(b, 24)).Copy Destination:=wksCheck.Cells(c, 1)
          .Rows("2:" & b).Clear
        End With
    'Hier bei der Zusammenführung der Daten aus der Tabelle DatenKurzcheck _
      aufbereitet in die Zieltabelle Daten Kurzcheck will ich das nur die _
      Spalten von A bis X aus der Tabelle Daten Kurzcheck aufbereitet geholt _
      werden und die Spalten ab Spalte X in der Zieltabelle Daten Kurzcheck nicht _
      überschrieben werden.
       
        b = wksFormel.Cells(Rows.Count, 3).End(xlUp).Row
        c = wksAufbereitet.Cells(Rows.Count, 1).End(xlUp).Row + 1
        wksFormel.Rows("2:" & b).Copy
        wksAufbereitet.Rows(c).Insert
        wksRoh.Rows("2:" & b).Clear
        
        Dim strFile As String
        Dim ff As Integer
        
        strFile = "O:\Technik\Daten.csv"
        
        ff = FreeFile
        
        Open strFile For Output As #ff
        Print #ff, vbNullString
        Close #ff
          
        Scannerdaten.Hide
    End If
    FormularWochenbericht.Show
End Sub

Herbers Excel/VBA-Archiv

Der kurze Weg zum Ziel: Auftragsprogrammierung

Makro funzt nicht so richtig | Herbers Excel-Forum