 Menü
 An- und Abmelden
 Partner / Links
|
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 - Packman
Seiten: [1]
1
« am: Juli 16, 2018, 10:50:28 Vormittag »
Hallo Thomas  Statt Rücknahme vielleicht! Für jeden Wunsch ein Makro! Gruß Packman Unter deinem ersten Makro einzufügen und eine Taste zuweisen! z.b. Dollar=strg+d Pfund=strg+p Euro =strg+e etc. Sub Währung_Dollar()
Selection.NumberFormat = "[$$-409]#,##0.00"
End SubSub Währung_Euro()
Selection.NumberFormat = "#,##0.00 $"
End Sub
2
« am: Juli 14, 2018, 21:11:15 Nachmittag »
Hallo Thommas Dann Probier dich mal! Gruß Packman Vba Editor aufruf Alt+F11 Vba Editor/Menü/Einfügen/Modul Den Code dort einfügen Vba Editor schliessen Excel Menü/Makro/Makros Die Namen der Makros werden angezeigt Ein Makro auswählen Optionen anwählen Dort kannst du jetzt eine Taste angeben (Strg +Taste) Fenster schliessen Angenommen du hast p angegeben Selektion beliebiger Zellen/Spalten/Zeilen Strg+p formatiert nun den selectierten Bereich Makro für Pfund! Sub Währung_Pfund()
Selection.NumberFormat = "[$£-809]#,##0.0000"
End Sub
3
« am: Juli 13, 2018, 21:58:18 Nachmittag »
Hallo Adoran Dein Code ergänzt! Gruß Packman Sub Schaltfläche1_Klicken()
Workbooks.Open (ActiveSheet.Cells(4, 1).Value)
ThisWorkbook.Worksheets("Tabelle1").Range("A:H").Copy
Worksheets("Tabelle1").Range("A1").PasteSpecial Paste:=xlValues
Worksheets("Tabelle1").Range("A1").Select
ActiveWorkbook.Close SaveChanges:=True
Application.CutCopyMode = False
End Sub
4
« am: Juli 13, 2018, 17:29:46 Nachmittag »
Hallo Thomas Mach dir doch für jede Währung ein Makro(das auf den Selectierten Bereich wirkt). Diesen kannst du dann einen Shortcut(Tastaturkürzel) zuweisen. Gruß Packnan
5
« am: Juni 25, 2018, 20:51:36 Nachmittag »
Hallo Community Ich kann den Post leider nicht korrigieren! Letzten einfach vergessen! Bin halt ein wenig durcheinander geworden bei diesem Code(Anfänger eben) Gruß Packman
6
« am: Juni 25, 2018, 20:47:11 Nachmittag »
Hallo Community Ops ... Im Code an 4 Stellen B ersetzen! Ist leicht zu entdecken! 3 mal bei Range("A1:B" 1 mal bei Columns("A:B") Gruß Packman Gruß Packman
7
« am: Juni 25, 2018, 20:14:17 Nachmittag »
Hallo Community Spalte b muss ein eindeutiger Wert sein,falls doppelte Werte in Spalte A sind Sortierspalten noch ergänzen,bei Columns("A:B"). im Code B ersetzen! Gruß Packman Sub Sortieren_mit_leeren_Zellen()
Dim FilteredRange() As Variant, FilteredRangeNeu() As Variant
Dim Zelle As Long, ZelleNeu As Long
FilteredRange = Range("A1:B" & ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row)
For Zelle = 2 To UBound(FilteredRange, 1)
If FilteredRange(Zelle, 1) = "" Then Cells(Zelle, 1) = Cells(Zelle - 1, 1)
Next Zelle
Columns("A:B").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
FilteredRangeNeu = Range("A1:B" & ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row)
For Zelle = UBound(FilteredRange, 1) To 2 Step -1
If FilteredRange(Zelle, 1) = "" Then
For ZelleNeu = UBound(FilteredRange, 1) To 2 Step -1
If FilteredRangeNeu(ZelleNeu, 1) = FilteredRange(Zelle - 1, 1) And FilteredRangeNeu(ZelleNeu, 1) = FilteredRangeNeu(ZelleNeu - 1, 1) And FilteredRangeNeu(ZelleNeu, 2) = FilteredRange(Zelle, 2) Then FilteredRangeNeu(ZelleNeu, 1) = ""
Next ZelleNeu
End If
Next Zelle
Range("A1:B" & ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row) = FilteredRangeNeu
End Sub
8
« am: Juni 25, 2018, 11:31:42 Vormittag »
Hallo Community ops,sollte ja ohne Vba sein bzw der Fragesteller zuwenig Vba Kenntnisse! Bei bedarf kann ich mich ja am Wochenende mal Probieren! Gruß Packman
9
« am: Juni 25, 2018, 11:24:57 Vormittag »
Hallo Community
Mit Vba
Daten in einem Array übernehmen,um später die leeren Zellen zu ermitteln
Auffülle der leerstehenden Zellen bei der Tabelle mit Daten der darüberliegenden Zelle
Dann Sortieren
Über eine Schleife das Array durchlaufen lassen und auf leere Zellen abtasten,der darüberliegende Wert ist der Suchbegriff
Bei der Tabelle Wert suchen und den darunterliegenden Wert wieder löschen
So lassen sich auch Tabellen Sortieren mit unterschiedlicher Anzahl von leeren Zellen(Arrayabfrage auf eine oder mehrere leere Zellen)!
Gruß Packman
10
« am: Juni 23, 2018, 22:39:55 Nachmittag »
Hallo Community Erstellung eines Datenfeldes mit der Splitfunktion und anschliessenden Paar vergleich aber Dein Tool wie auch mein Vorschlag sind Fehlerhaft! z.b. Das Auto Auto ist blau Ergebnis Das Auto ist blau Das das das darf Ergebnis Das darf Wobei alle 3 das ihre Aussage haben und keines von den 3 doppelt ist Es müssen also die Grammatikregeln mit berücksichtigt werden! Grammatik bin ich nun ganz schlecht Gruß Packman
11
« am: Juni 19, 2018, 12:20:06 Nachmittag »
Hallo Squal Jeder hat mal angefangen! Wie heisst es so schön! Nicht der Fragesteller ist der unwissende,eher der zu Anrwortende,da er längst nicht alle Fragen zu beantworten weiss! Also immer Fragen Gruß Packman
12
« am: Juni 16, 2018, 10:37:39 Vormittag »
Hallo Squal Bezugnehmend zum letzten Bild! Hinter dem Sub solltest du einen Makronamen angeben! Am besten einen Aussagekräftigen Namen,der zum Makro Passt. Dann noch folgendes! Laut Bild versuchst du in Tabelle1 das Makro einzufügen! Somit wird bei Range oder auch Cells immer auf Tabelle1 bezug genommen! Sollte kein Ereigniss gewünscht sein,gehört dein Makro in ein allgemeines Modul,dort wo du Module zu stehen hast, dann aber vor Range oder Cells Worksheets("Tabelle1") oder andere Tabellennamen angeben! Noch ein Tip für zukünftige Makros und dessen Variablen! Schreibe vor einem Makro! Option Explicit diese Anweisung zwingt dich Variablen zu bestimmen,so kannst diese nicht vergessen Gruß Packman
13
« am: Juni 16, 2018, 04:20:00 Vormittag »
Hallo Squal Vielleicht verbundene Zellen oder geschützte Zellen/Bereiche? Gruß Packman
14
« am: Juni 15, 2018, 20:59:18 Nachmittag »
Hallo Squal Probier mal  Gruß Packman Sub PLCalsKaufkurs()
Worksheets("Tabelle1").Range("I9").Copy
Worksheets("Tabelle1").Range("B4").PasteSpecial Paste:=xlValues
End Sub
15
« am: Juni 12, 2018, 20:12:37 Nachmittag »
Hallo Cole Nochmal überarbeitet Gruß Packman Sub DateienLesen()
Call EventsOff
Dim DateiName As String, Dpfad As String
Dpfad = OrdnerAuswahl
DateiName = Dir(Dpfad & "*.xls")
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:=Dpfad & DateiName
Workbooks(DateiName).Worksheets(1).Range("A7:C132").Copy
ThisWorkbook.Worksheets(1).Range("A" & ThisWorkbook.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlValues, Operation:=xlNone
Workbooks(DateiName).Close SaveChanges:=False
End If
DateiName = Dir
Loop
Call EventsOn
End Sub
Function OrdnerAuswahl() As String
On Error GoTo FehlerRoutine
Dim AppShell As Object
Dim BrowseDir As Variant
Set AppShell = CreateObject("Shell.Application")
Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
OrdnerAuswahl = BrowseDir.items().Item().Path & "\"
FehlerRoutine:
End Function
Public Sub EventsOff()
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Public Sub EventsOn()
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
16
« am: Juni 12, 2018, 15:57:38 Nachmittag »
Hallo Cole ops Diese Zeile korrigieren Workbooks.Open Filename:=Dpfad & DateiName
Dpfad & kann noch gelöscht werden! Gruß Packman
17
« am: Juni 12, 2018, 15:43:35 Nachmittag »
Hallo Cole Probier mal! Gruß Packman Sub DateienLesen()
Call EventsOff
Dim DateiName As String
DateiName = Dir(OrdnerAuswahl & "\" & "*.xls")
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:=Dpfad & DateiName
Workbooks(DateiName).Worksheets(1).Range("A7:C132").Copy
ThisWorkbook.Worksheets(1).Range("A" & ThisWorkbook.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlValues, Operation:=xlNone
Workbooks(DateiName).Close SaveChanges:=False
End If
DateiName = Dir
Loop
Call EventsOn
End Sub
Function OrdnerAuswahl() As String
On Error GoTo FehlerRoutine
Dim AppShell As Object
Dim BrowseDir As Variant
Set AppShell = CreateObject("Shell.Application")
Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
OrdnerAuswahl = BrowseDir.items().Item().Path & "\"
FehlerRoutine:
End Function
Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Seiten: [1]
|
Beiträge anzeigen