Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 08:01:34
Textbox Inhalt prüfen und Code abbrechen
24.04.2024 06:38:45
Kumulierte Daten für Intervalllaufeinheiten
24.04.2024 04:37:43
Mit Word erstellte PDF als Anhang an E-Mail anhängen
24.04.2024 00:20:14
Bestimmte Spalten als xls exportieren per Makro
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1864to1868
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1864to1868
1864to1868
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Excel

Excel
20.01.2022 11:23:47
D.Mayer
Moin, moin!
Ich habe mal eine Frage in die Runde:
Wie kann ich von z.B. von Zelle A5 nach unten - nach der ersten Zahl 25 in Spalte A suchen - und somit alle Zellen nach unten mit der 25 markieren -
in der Breite so weit, wie die in der ersten Zeile Überschriften stehen, um den ganzen Bereich auszuschneiden und rechts ans Ende zu hängen?
Puh, ich hoffe man kann das so verstehen!?
Ich benötige das für einen Teil in einem Makro.
Herzlichen Dank schon mal.
Liebe Grüße,
Daniel

20
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
super Betreff
20.01.2022 11:36:37
Rudi
Hallo,
so:

Sub aaaa()
Dim rngF As Range, lngColumns As Long
Set rngF = Columns(1).Find(what:=25, after:=Range("A5"), LookIn:=xlValues, lookat:=xlPart)
If Not rngF Is Nothing Then
lngColumns = Application.CountA(Rows(1))
Range(Range("A5"), rngF).Resize(, lngColumns).Cut Range("A5").Offset(, lngColumns)
End If
End Sub
Gruß
Rudi
AW: super Betreff
20.01.2022 12:50:46
D.Mayer
Moin Rudi,
vielen Dank. Ich habe da bei der Fragestellung dann einen Fehler gemacht.
Also es muss beginnen mit...
Markiere Spalte A komplett und such nach der ersten 2, dann markiere von dort alles nach unten usw.
Also der Anfang fehlt mir quasi.
LG Daniel
Anzeige
erst 2 dann 25 suchen
20.01.2022 13:09:00
Rudi
so?

Sub aaaa()
Dim rngF2 As Range, rngF25 As Range, lngColumns As Long
Set rngF2 = Columns(1).Find(what:=2, after:=Range("A1"), LookIn:=xlValues, lookat:=xlWhole)
If Not rngF2 Is Nothing Then
Set rngF25 = Columns(1).Find(what:=25, after:=rngF2, LookIn:=xlValues, lookat:=xlWhole)
If Not rngF2 Is Nothing Then
lngColumns = Application.CountA(Rows(1))
Range(rngF2, rngF25).Resize(, lngColumns).Cut rngF2.Offset(, lngColumns)
End If
End If
End Sub

AW: erst 2 dann 25 suchen
20.01.2022 13:24:59
D.Mayer
Die folgende Zeile bereitet Probleme...
Range(rngF2, rngF25).Resize(, lngColumns).Cut rngF2.Offset(, lngColumns)
Userbild
Anzeige
AW: erst 2 dann 25 suchen
20.01.2022 13:31:48
D.Mayer
Ahhh... jetzt habe ich es verstanden:
Nein, er soll nur nach 2 in Spalte A suchen.... und von der ersten 2 dann nach unten markieren bis zur letzten 2 in Spalte A.
Und dann nach rechts rüber, so weit, wie es Überschriften in Zeile 1 gibt. Das alles soll dann als Block ans Ende (rechts oben) neben den Überschriften
in Zeile 1 eingefügt werden.
AW: erst 2 dann 25 suchen
20.01.2022 13:34:49
D.Mayer
Ahhh... jetzt habe ich es verstanden:
Nein, er soll nur nach 2 in Spalte A suchen.... und von der ersten 2 dann nach unten markieren bis zur letzten 2 in Spalte A.
Und dann nach rechts rüber, so weit, wie es Überschriften in Zeile 1 gibt. Das alles soll dann als Block ans Ende (rechts oben) neben den Überschriften
in Zeile 1 eingefügt werden.
Anzeige
letzter Versuch
20.01.2022 13:46:24
Rudi 

Sub aaaa()
Dim rngF2a As Range, rngF2b As Range, lngColumns As Long
'1te 2 suchen
Set rngF2a = Columns(1).Find(what:=2, after:=Range("A1"), LookIn:=xlValues, lookat:=xlWhole)
If Not rngF2a Is Nothing Then 'gefunden
'2te 2 suchen
Set rngF2b = Columns(1).Find(what:=2, after:=rngF2a, LookIn:=xlValues, lookat:=xlWhole)
If Not rngF2b Is Nothing Then 'gefunden
lngColumns = Application.CountA(Rows(1))  'Anzahl in Zeile1
'auschneiden/ kopieren
Range(rngF2a, rngF2b).Resize(, lngColumns).Cut Cells(1, 1).Offset(, lngColumns)
End If
End If
End Sub

AW: letzter Versuch
20.01.2022 13:52:58
D.Mayer
Hallo Rudi, das scheint jetzt soweit zu passen.
Einziger Haken:
Es wird nun von 2 bis zur nächsten 2 ausgeschnitten.
Es müsste hier von 2 bis zur letzten 2 in Spalte A ausgeschnitten werden.
Anzeige
aller letzter Versuch
20.01.2022 13:59:24
Rudi 

Sub aaaa()
Dim rngF2a As Range, rngF2b As Range, lngColumns As Long
'1te 2 suchen
Set rngF2a = Columns(1).Find( _
what:=2, after:=Range("A1"), _
LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext)
If Not rngF2a Is Nothing Then 'gefunden
'2te 2 suchen
Set rngF2b = Columns(1).Find( _
what:=2, after:=rngF2a, LookIn:=xlValues, _
lookat:=xlWhole, searchdirection:=xlPrevious)
If Not rngF2b Is Nothing Then 'gefunden
lngColumns = Application.CountA(Rows(1))  'Anzahl in Zeile1
'auschneiden/ kopieren
Range(rngF2a, rngF2b).Resize(, lngColumns).Cut Cells(1, 1).Offset(, lngColumns)
End If
End If
End Sub

Anzeige
AW: aller letzter Versuch
20.01.2022 14:20:03
D.Mayer
Hallo Rudi,
vielen lieben Dank für die Lösung meines Problems!!!
Es war nicht so einfach, das Problem zu schildern... zumal ich mich noch mit der 2 und der 25 verschrieben habe.
Danke, dass Du mir geholfen hast.
Ich hätte das so nie hinbekommen!
DANKE! DANKE! DANKE!
Gruß,
Daniel
AW: super Betreff
24.01.2022 07:29:12
D.Mayer
Moin, moin Rudi,
ich hatte eigentlich gehofft, das alleine (mit etwas Hilfe) hinzubekommen, aber ich bin an der Liste leider kläglich gescheitert :(
Ich habe mir gedacht, ich frage Dich einfach, ob Du mir oder ob mir hier generell noch einmal jemand helfen kann. Ich habe es nun nach tagelangem Kopfrauchen aufgegeben... Und ich sage es ungern, aber ich ärgere mich tatsächlich extrem über mich selbst, dass ich scheinbar zu doof bin, diese Textdatei ins Reine zu bringen. *grrrrr
Die Textdatei wird leider so bescheiden von unserer EDV geliefert (Inhalte sind verändert Layout nicht)...
Daran ist nichts zu machen. Wir (das Fußvolk) benötigen die Liste unbedingt und müssen nahezu täglich
damit arbeiten. Die Liste geht natürlich nach unten über tausende Zeilen. Für Dich/ Euch wahrscheinlich ein
Kinderspiel... für mich aber leider eine Nummer zu groß :(
https://www.herber.de/bbs/user/150614.txt
Vielen Lieben Dank bereits an dieser Stelle,
Daniel
Anzeige
AW: super Betreff
24.01.2022 07:34:42
D.Mayer
Als Ergänzung noch einmal:
Es wird ein Makro benötigt, welches die Liste(emailftp.txt) in Excel öffnet und ins "Reine" bringt und danach am gleichen Speicherort als Exceldatei abspeichert. Die txt. kann als Datei am Speicherort bleiben.
Die Liste ist nach unten flexibel und es sind mal mehr und mal weniger Zeilen.
AW: super Betreff
24.01.2022 07:44:46
Oberschlumpf
Hi,
ich hab mal deine txt-Datei als CSV in Excel eingelesen, und das hier kam dabei raus:
https://www.herber.de/bbs/user/150616.xlsx
Ich vermute, DAS ist auch noch nicht das, was du als fertige Excel-Datei speichern möchtest, weil noch immer alles ziemlich durcheinander aussieht (zumindest für mich), oder?
Daher bitte ich dich, dass du in der von mir gezeigten Excel-Datei alle Daten mal so verschiebst/neu anordnest/sonstiges, wie du es dir vorstellst, wie die für dich fertige Excel-Datei aussehen soll.
Dann zeigst du uns bitte wieder per Upload deine fertige Excel-Datei - vielleicht findet von uns dann ja jemand ein Muster, um die ganze Arbeit für dich in zukunft zu automatisieren.
...beachte, dass jeder Beitrag nach einer bestimmten Zeit im Archiv "verschwindet"...
Ciao
Thorsten
Anzeige
AW: super Betreff
24.01.2022 08:27:44
D.Mayer
Hi Thorsten,
anbei einmal die Datei, wie sie am Ende aussehen sollte...
https://www.herber.de/bbs/user/150617.xlsx
Eine Katastrophe, was unsere EDV uns da liefert.
Danke schön, dass Du Dich meinem Problem angenommen hast.
Gruß,
Daniel
AW: super Betreff
24.01.2022 09:30:07
D.Mayer
Moinsen!
Anbei noch einmal die Datei, wie sie am Ende aussehen sollte...
https://www.herber.de/bbs/user/150617.xlsx
Eine Katastrophe, was unsere EDV uns da liefert.
Danke schön, dass Du Dich meinem Problem angenommen hast.
Gruß,
Daniel
Anzeige
AW: super Betreff
24.01.2022 10:17:44
peterk
Hallo
Zum Konvertieren Deines TXT Files (Filenamen anpassen)

Option Explicit
Sub Convert()
Const InFile = "C:\Users\...\Downloads\150614.txt"
Const OutFile = "C:\Users\...\Downloads\150614.csv"
Dim Inline As String
Dim Outline As String
Dim i As Integer
Dim myMod As Integer
myMod = 3
i = 0
Open InFile For Input As #1
Open OutFile For Output As #2
Do While Not EOF(1)
Line Input #1, Inline
i = i + 1
Outline = Outline & Inline
If (i Mod myMod) = 0 Then
Print #2, Outline
Outline = ""
i = 0
myMod = 4
End If
Loop
Close #1
Close #2
End Sub
Peter
Anzeige
ja, cool...
24.01.2022 10:39:04
Oberschlumpf
...so geht es!
Hi Peter,
hab dein Makro mit der "neuen" Excel-Datei Daniel getestet - funktioniert! :-)
Daniel, jetzt hast du zusätzlich eine CSV-Datei, dank Peters Code, die du nur noch korrekt in Excel einlesen musst - dann hast du auch deine Excel-Datei.
Ciao
Thorsten
..kleine Bitte...wieso immer sooooo lange mit Bsp-Datei warten?...bei nächsten Fragen bitte gleich eine Bsp-Datei per Upload zeigen...
AW: ja, cool...
24.01.2022 11:42:31
D.Mayer
Moin, moin!
In CSV sieht das total klasse aus. Aber wenn ich das Makro weiterschreibe...
Also in Excel speichern möchte und noch vorher "Text in Spalten" verwende, dann kommt nur murks dabei heraus.
Verstehe ich überhaupt nicht. Ich habe sogar nach der "Aufzeichnung" einfach nur Müll in der Excel-Datei. Obwohl der Vorgang
zu 100% im normalen Workflow so ist. Hääää? Oh man, ich glaube die Datei hat mir den Kopf verdreht :)
AW: ja, cool...
24.01.2022 13:08:50
D.Mayer
Herzlichen Dank an alle Heferlein :)
- Thema kann in die Ablage -
Wenn man das so sieht... Makro in wenigen Zeilen geschrieben. MEGA!!!
DANKE SCHÖN!!!!
direkt als .xlsx
24.01.2022 14:55:56
Rudi
Hallo,
Peters Code aufgebohrt.
.XLSX wird im selben Ordner unter dem gleichen Namen wie InFile abgelegt.

Sub Convert()
Const InFile = "C:\test\150614.txt"
Dim Inline As String
Dim Outline As String
Dim i As Integer
Dim myMod As Integer
Dim vntConvert, vntTmp, j As Integer, vntOUT()
Application.ScreenUpdating = False
myMod = 3
i = 0
Open InFile For Input As #1
Do While Not EOF(1)
Line Input #1, Inline
i = i + 1
Outline = Outline & Inline
If (i Mod myMod) = 0 Then
vntConvert = vntConvert & vbCrLf & Outline
Outline = ""
i = 0
myMod = 4
End If
Loop
Close #1
vntConvert = Mid(vntConvert, 2)
vntConvert = Split(vntConvert, vbCrLf)
vntTmp = Split(vntConvert(0), ";")
ReDim vntOUT(UBound(vntConvert), UBound(vntTmp))
For i = 0 To UBound(vntConvert)
vntTmp = Split(vntConvert(i), ";")
For j = 0 To UBound(vntTmp)
vntOUT(i, j) = vntTmp(j)
Next j
Next i
With Workbooks.Add
.Sheets(1).Cells(1, 1).Resize(UBound(vntOUT) + 1, UBound(vntOUT, 2) + 1) = vntOUT
.SaveAs Replace(InFile, ".txt", ""), xlOpenXMLWorkbook
.Close
End With
End Sub
Gruß
Rudi

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige