PDA

Vollständige Version anzeigen : Makro bestimmten wert Makieren und Zelle makieren


Janspitzi
08.12.2017, 11:09
Hallo ihr lieben,

Ich möchte ein Makro schreiben in dem eine Tabelle geöffnet werden kann (habe ich schon) dann soll das selbe Makro einen bestimmten Wert (F_09) Suchen und diese Zelle makieren damit das Makro danach in den Zellen darunter alle Kommas erstetzt, eine neue Spalte macht und dort alles nach dem Koma einträgt(habe ich auch schon)


Mein Code bis jetzt:


Sub OeffnenDialog_mit_Pfadvorgabe()

'** Anzeige des Öffnen-Dialogfensters mit voreingestelltem Pfad

'** Dimensionierung der Variablen
Dim wb As Workbook
'Dim ws As Worksheet
Dim lngZ As Long
Dim strFileName
Dim strFilter As String

'** Dateifilter definieren
strFilter = "Excel-Dateien(*.xl*), *.xl*"


'** Den im Dialogfeld gewählten Namen auslesen
strFileName = Application.GetOpenFilename(strFilter)

'** Prüfen, ob eine gültige Datei ausgewählt wurde
If strFileName = False Then Exit Sub

'** Gewählte Datei öffnen
Set wb = Workbooks.Open(strFileName)


Hier soll die Zelle makiert werden

Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

End Sub

rastrans
08.12.2017, 11:37
Diese Funktion sucht dir in einer Arbeitsmappe einen TextFunction Suche(wb As Workbook, SuchText As String) As Range
Dim rng As Range
Dim ws As Worksheet
Dim bolFound As Boolean

Set wb = ThisWorkbook
For Each ws In wb.Worksheets
Set rng = ws.Cells.Find(What:=SuchText, LookAt:=xlWhole)
bolFound = Not rng Is Nothing
If bolFound Then Exit For
Next
Set Suche = rng
End FunctionIn deinem Code muss dann Dim rng As Range

Set rng = Suche(wb, "F_09")
If Not rng Is Nothing Then
rng.Parent.Activate
rng.Select
End If

Janspitzi
08.12.2017, 12:26
Danke dir erstmal für die schnelle Antwort und Hilfe,

es funktioniert auch einwandfrei er macht auch fast alles,
er öffnet die tabelle und macht auch die neue Zelle aber er nimmt dann komischerweise den wert nach dem Koma nicht rüber

Mein Code

Function Suche(wb As Workbook, SuchText As String) As Range
Dim rng As Range
Dim ws As Worksheet
Dim bolFound As Boolean

Set wb = ThisWorkbook
For Each ws In wb.Worksheets
Set rng = ws.Cells.Find(What:=SuchText, LookAt:=xlWhole)
bolFound = Not rng Is Nothing
If bolFound Then Exit For
Next
Set Suche = rng
End Function
Sub OeffnenDialog_mit_Pfadvorgabe()
'** Anzeige des Öffnen-Dialogfensters mit voreingestelltem Pfad

'** Dimensionierung der Variablen
Dim wb As Workbook
'Dim ws As Worksheet
Dim lngZ As Long
Dim strFileName
Dim strFilter As String

'** Dateifilter definieren
strFilter = "Excel-Dateien(*.xl*), *.xl*"


'** Den im Dialogfeld gewählten Namen auslesen
strFileName = Application.GetOpenFilename(strFilter)

'** Prüfen, ob eine gültige Datei ausgewählt wurde
If strFileName = False Then Exit Sub

'** Gewählte Datei öffnen
Set wb = Workbooks.Open(strFileName)


Dim rng As Range

Set rng = Suche(wb, "F_09")
If Not rng Is Nothing Then
rng.Parent.Activate
rng.Select


Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
End If
End Sub

Janspitzi
08.12.2017, 13:18
Also mein eigentliches Ziel sit es das ich die Excel Tabelle öffne er automatisch dieses Makro startet frag was er öffnen soll wenn

Nein dann automatisch schliesen

ja dann die tabelle öffnen

in zeile F_09 alles nach dem koma in eine neue Zelle dahinter schiebt

und dies dann unter einem bestimmten Namen (Abfallexport) speichert.

Janspitzi
13.12.2017, 10:09
Danke dir erstmal für die schnelle Antwort und Hilfe,

es funktioniert auch einwandfrei er macht auch fast alles,
er öffnet die tabelle und macht auch die neue Zelle aber er nimmt dann komischerweise den wert nach dem Koma nicht rüber

Mein Code

Function Suche(wb As Workbook, SuchText As String) As Range
Dim rng As Range
Dim ws As Worksheet
Dim bolFound As Boolean

Set wb = ThisWorkbook
For Each ws In wb.Worksheets
Set rng = ws.Cells.Find(What:=SuchText, LookAt:=xlWhole)
bolFound = Not rng Is Nothing
If bolFound Then Exit For
Next
Set Suche = rng
End Function
Sub OeffnenDialog_mit_Pfadvorgabe()
'** Anzeige des Öffnen-Dialogfensters mit voreingestelltem Pfad

'** Dimensionierung der Variablen
Dim wb As Workbook
'Dim ws As Worksheet
Dim lngZ As Long
Dim strFileName
Dim strFilter As String

'** Dateifilter definieren
strFilter = "Excel-Dateien(*.xl*), *.xl*"


'** Den im Dialogfeld gewählten Namen auslesen
strFileName = Application.GetOpenFilename(strFilter)

'** Prüfen, ob eine gültige Datei ausgewählt wurde
If strFileName = False Then Exit Sub

'** Gewählte Datei öffnen
Set wb = Workbooks.Open(strFileName)


Dim rng As Range

Set rng = Suche(wb, "F_09")
If Not rng Is Nothing Then
rng.Parent.Activate
rng.Select


Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
End If
End Sub


Also mein eigentliches Ziel sit es das ich die Excel Tabelle öffne er automatisch dieses Makro startet frag was er öffnen soll wenn

Nein dann automatisch schliesen

ja dann die tabelle öffnen

in zeile F_09 alles nach dem koma in eine neue Zelle dahinter schiebt

und dies dann unter einem bestimmten Namen (Abfallexport) speichert.