SirHaxe
Grünschnabel
Hallo, ich habe das Problem das Excel meinen Code nach dem ersten "end sub" abbricht.
gestern hat er das allerdings noch gemacht, über Nacht geht der Code plötzlich nicht mehr.
ps: wo kann ich meine email ändern die hier hinterlegt ist ?
gestern hat er das allerdings noch gemacht, über Nacht geht der Code plötzlich nicht mehr.
Visual Basic:
Public criteria As String
Sub Harambe()
On Error Resume Next
' lo '
Dim fDialog As Office.FileDialog
Dim varFile As Variant
' Set up the File Dialog. '
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
' Allow user to make multiple selections in dialog box '
.AllowMultiSelect = False
' Set the title of the dialog box. '
.Title = "Bitte eine Datei auswählen"
' Clear out the current filters, and add our own.'
.Filters.Clear
.Filters.Add "All Files", "*.csv"
' Show the dialog box. If the .Show method returns True, the '
' user picked at least one file. If the .Show method returns '
' False, the user clicked Cancel. '
If .Show = True Then
Else
x = MsgBox("Sie haben Abbrechen gedrückt.", 0 + 64, "Abbruch durch Nutzer")
End If
End With
Sheets.Add After:=Sheets(Sheets.Count)
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & fDialog.SelectedItems(1), Destination:=Range("$A$1"))
.Name = "test"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
Sub neingag(criteria As String, country As String)
' filter
Range("A1:$Q").Select
Range("A4").Activate
Selection.AutoFilter
ActiveSheet.Range("$A:$Q").AutoFilter Field:=14, Criteria1:="=" & criteria & "*" _
, Operator:=country
If country = "" Then
ActiveSheet.Range("$A:$Q").AutoFilter Field:=15
Else
ActiveSheet.Range("$A:$Q").AutoFilter Field:=15, Criteria1:=country
End If
End Sub
Sub gnoekel(criteria As String)
' ---
Dim Ws As Worksheet
Sheets.Add After:=Sheets(Sheets.Count)
Worksheets("Tabelle16").Activate
Columns("A:A").Select
'Kopiere Spalte A aus Quelldaten in letzte Tabelle
Selection.Copy
Worksheets(Sheets.Count).Activate
ActiveSheet.Paste
Range("C2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "1/1/2016"
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C367"), Type:=xlFillDefault
Range("C2:C367").Select
' Benenne Spalten
Range("C1").Select
ActiveCell.FormulaR1C1 = "Zeitpunkt"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Summe"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-3],""<=""&RC[-1])"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C1,""<=""&RC[-1])"
Range("D2").Select
Selection.AutoFill Destination:=Range("D2:D367"), Type:=xlFillDefault
Range("D2:D367").Select
ActiveWindow.ScrollRow = 1
Range("C1").Select
Range("C1:D367").Select
' Erstelle Diagramm
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range("$C$1:$D$367")
ActiveChart.ChartType = xlLine
Columns("A:A").EntireColumn.AutoFit
Sheets(Sheets.Count).Name = kriterium
Sheets("Tabelle16").Select
Selection.AutoFilter
End Sub
Sub wasd(country As String)
'Die Filter
filter1 "EM", ""
copy1 "EM (Welt)"
filter1 "EM DG", ""
copy1 "EM DG"
filter1 "EM TR", ""
copy1 "EM TR"
filter1 "EM TS", ""
copy1 "EM TS"
filter1 "EM HP", ""
copy1 "EM HP"
filter1 "EM LP", ""
copy1 "EM LP"
filter1 "EM MS", ""
copy1 "EM MS"
filter1 "EM", "DE"
copy1 "EM"
End Sub
ps: wo kann ich meine email ändern die hier hinterlegt ist ?
Zuletzt bearbeitet von einem Moderator: