online 1
gast (50)

/ Forum / Tabellenkalkulation

TabellenkalkulationTabellenkalkulation

Fragevon sebal vom 05.11.2019, 14:39 Options

Zellen auslesen

hallo zusammen,

ich habe eine frage, vor mir liegt in etwa so etwas:

%r
12
12
22
%RES
1
1
2
5
%*
22
2
22
%RES
1
1
1
1
1
9
%*
1
1
12
33
%RES
12
12
12
14
143
%*
a
%RES END

Mein makro soll folgendes können: immer wenn es auf %RES trifft 2 zeilen runter gehen und dann die nachfolgenden werte bis zu %* auslesen (untereinander) und das immer wieder bis es auf %RES END stößt ( wie viele solche forgänge es gibt ist variabel)
hier würde das ergebnis dann so aussehen sollen:

1
2
5
1
1
1
1
9
12
12
14
143

vielen dank im voraus, vllt kann mir ja jemand helfen
gruß sebal


Antwort schreiben

Antwort 1 von coros vom 05.11.2019, 15:01 Options

HAllo Sebal,

nachfolgendes Makro sollte das machen, was Du Dir vorgestellt hast.

Mit dem Makro wird Spalte A nach Deinen Vorgaben, also "%RES" und "%*" durchsucht und die dazwischen liegenden Daten werden in ein Tabellenblatt mit dem Namen "Auswertung", das automatisch erzeugt wird, kopiert.

Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.

[b]Option Explicit

Sub Suchen_und_kopieren()
Dim iRow As Long
Dim jRow As Long
Dim strAktSheet As String
Dim iSheets As Integer
Application.ScreenUpdating = False
strAktSheet = ActiveSheet.Name

For iSheets = Worksheets.Count To 1 Step -1
If Sheets(iSheets).Name = "Auswertung" Then
Application.DisplayAlerts = False
Sheets(iSheets).Delete
Application.DisplayAlerts = False
Exit For
End If
Next
With Worksheets.Add
.Name = "Auswertung"
End With

For iRow = 1 To Sheets(strAktSheet).Range("A65536").End(xlUp).Row
    If Sheets(strAktSheet).Cells(iRow, 1) = "%RES END" Then Exit Sub
    
    If Sheets(strAktSheet).Cells(iRow, 1) = "%RES" Then
        For jRow = iRow + 2 To Sheets(strAktSheet).Range("A65536").End(xlUp).Row
            If Sheets(strAktSheet).Cells(jRow, 1) = "%*" Then
                Sheets(strAktSheet).Range("A" & iRow + 2 & ":A" & jRow - 1).Copy
                Sheets("Auswertung").Cells(Sheets("Auswertung").Range("A65536").End(xlUp).Offset(1, 0).Row, 1).PasteSpecial
            Exit For
            End If
        Next jRow
    End If
Next iRow
End Sub
[/b]


Ich hoffe, Du kommst klar.

Solltest Du nicht wissen, wie Du den Code in Deine Datei bekommst, dann schau mal auf meiner HP in der Rubrik Anleitungen und dort dann in der Anleitungsnummer 3 nach. Dort stelle ich dazu eine bebilderte Anleitung zur Verfügung, die Dir sicherlich helfen wird.

Bei Fragen melde Dich.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 2 von sebal vom 06.11.2019, 07:14 Options

hallo oliver,

vielen dank erst mal,
die probe mit einer Testdatei hat schon mal funktioniert, jetzt muss ich es nur noch mit der orginaldatei versuchen,
in wie fern ändert sich das makro, wenn ich nicht 2 sonder 5 zeilen runter gehen möchte? vielen dank nochmals

gruß sebal

Antwort 3 von coros vom 06.11.2019, 07:20 Options

Hallo sebal,

Du musst in dem Makro in den Zeilen

[b]For jRow = iRow + 2 To Sheets(strAktSheet).Range("A65536").End(xlUp).Row[/b]


und

[b]Sheets(strAktSheet).Range("A" & iRow + 2 & ":A" & jRow - 1).Copy
[/b]


die Zahl 2 hinter dem Pluszeichen ( + ) gegen die Zahl 5 tauschen.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 4 von sebal vom 06.11.2019, 07:36 Options

hallo oliver,

danke, hab ich selbst raus gefunden.

ABER:
nun möchte ich auf den bereich den dein programm ausgelesen hat (egal wie groß dieser ist, kann variabel sein) zugreifen und seinen Minimum und MAximum ausrechen, dieser wert soll dann in dem Arbeitsblatt Tabelle1 in A589 bzw A590 stehen.

nach deinem makro habe ich folgendes angehängt, aber hat nicht funktioniert:

Dim M As Long
M = Application.WorksheetFunction.Min(Range("A2:A8"))
Range("C2").Value = M

vllt kannst du mir auch hierbei helfen, vielen dank
gruß sebal

Antwort 5 von coros vom 06.11.2019, 07:52 Options

Hallo sebal,

nicht verständlich, was Du genau willst. Welchen Bereich meinst Du? Den in dem Tabellenblatt, in dem alle Daten stehen oder den Bereich, in dem Tabellenblatt "Auswertung" was ja automatisch erzeugt wird.

Du schreibst, dass der Wert in A589 bzw. A590 angezeigt werden soll. Nach welchen Kriterium entscheidet es sich denn, in welcher der beiden Zellen das Ergebnis angezeigt werden soll?

Was hat das mit Deinem Beispielmakro auf sich? In dem Makro sind keinerlei Daten bzw. Bereiche, von denen Du vorher gesprochen hast.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 6 von sebal vom 06.11.2019, 08:07 Options

hallo oliver,

es bezieht sich auf den bereich der "neu" entstanden ist in dem Tabellenblatt Auswertung, hiervon möchte ich das minimum u maximum haben, es soll bei meiner orginaldatei (von mir festgelegt) in Zellen A 589 (Min) u A590(Max) stehen.

in meinem makor habe ich ja nur irgend welche bereiche hingeschrieben, arbeite ja zur zeit nur mit einer test datei, in meiner orginal datei soll das min bzw max in A589 bzw A590 stehen, wo es im testbeispiel steht ist eigtl egal deswegen etwas verwirrend.

vllt zum verständnis mein bisheriges orginal makor sieht so aus ( hat aber mit dem was ich dich frage nichts zu tun ), dieser bereich den du mit deinem makro ansprichst ist in jeder datei die mein orginal makro öffnen kann vorhanden also %RES %* und % RES END

kmappe = ActiveWorkbook.Name
ksheet = ActiveSheet.Name

muifilename = Application.GetOpenFilename("MUI-File (*muf), *muf", 1, "please select MUI-File")
muiabb = Trim(muifilename)
If muiabb = "Falsch" Then Exit Sub




Workbooks.OpenText Filename:=muifilename, Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
, ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, Comma:= _
False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1) _
, Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1))


ActiveSheet.Range("K20:AZ1200").Select
Selection.ClearContents
ActiveSheet.Range("AD140").Select
ActiveCell.Value = muifilename


kabb = 0
kspx = 0
k = 1
kcol = 2
krow = 1
kstream = 0
kvar = 0
kts = 0
lfound = False

kspalte = 30
kreihe = 145
With ActiveSheet
.Cells(krow, kcol).Select
If Cells(1, kcol) = "%%CONT" Then
Do Until lfound
krow = krow + 1
If .Cells(krow, kcol).Value = "%%RES4w" Then
krow = krow + 2
lfound = True
Exit Do
End If
If krow = 10000 Then
krow = 1
lfound = True
kabb = 1
Exit Do
End If
Loop
lfound = False
Do Until lfound
If kabb = 1 Then
lfound = True
Exit Do
End If

.Range(Cells(krow, kcol), Cells(krow, kcol + 6)).Copy
.Cells(kreihe, kspalte).Select
.Paste
krow = krow + 1
kspalte = kspalte + 6
If .Cells(krow, kcol).Value = "%parting" Then
kreihe = kreihe + 1
kspalte = 30
End If
If .Cells(krow, kcol).Value = "%%ZIG1" Then
lfound = True
Exit Do
End If
If krow = 10000 Then
krow = 1
lfound = True
Exit Do
End If
Loop
End If



End With
kmui = ActiveWorkbook.Name

Range("AD140:IG650").Select
Selection.Copy
Windows(kmappe).Activate
Sheets("Tabelle3").Activate
Range("AB140:IE650").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets(ksheet).Select
Windows(kmui).Close

also mir geht es nochamls darum, wie ich nun minimu und maximum berechnen kann aus dem bereich in auswertung, wieso funkt das so wie ich es gemacht habe nicht

danke
sebal

Antwort 7 von sebal vom 06.11.2019, 08:17 Options

hallo oliver,

auf deiner HP steht wie man das makro als zusätzliches modul in den VB editor bekommt, ich möchte jedoch dieses makor in meinem programm integriert haben oder geht das nicht?

oder kann man es zusätzlich wie auf deiner HP beschreiben einfügen und dann beide module gleichzeitig laufen lassen?

mein bisheriges programm ist das in meiner vorherigen antwort.

gruß sebal

Antwort 8 von sebal vom 06.11.2019, 08:25 Options

hallo nochmal,

jetzt habe ich bei meiner testdatei ein neues module erstellt:

sub min()

Dim M As Long
M = Application.WorksheetFunction.Min(Range("A2:A8"))
Range("C2").Value = M

End Sub

dieses hat dann funktioniert, wieso?

und wieso funktioniert es nicht, wenn ich es einfach unter dein makro schreibe, das verstehe ich nicht.

danke
gruß sebal

Antwort 9 von coros vom 06.11.2019, 08:31 Options

Hallo sebal,

in welchem Tabellenblatt sollen die beiden Werte erscheinen? In dem neu erzeugten Blatt "Auswertung" oder in dem Blatt, in dem sich die Originaldaten befinden?
Wenn die beiden Werte in dem Originalblatt erscheinen sollen, gehe ich dann richtig in der Annahme, dass die Zahlenreihe, die Du asuwerten willst, spätestens in Zeile 588 in Spalte A aufhört? Das müsste man noch wissen.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 10 von coros vom 06.11.2019, 08:39 Options

Hallo sebal,

der Grund, warum das mit dem von mir geposteten Makro nicht funktioniert ist, weil sobald "%RES END" gefunden wird, das Makro beendet wird. Man muss hier mit einer Sprungmarke arbeiten.

Aber trottzdem muss man noch die Antworten auf meine Frage aus AW9 haben, um das abzuändern.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 11 von sebal vom 06.11.2019, 08:43 Options

hallo oliver,

die werte sollen in dem tabellenblatt erscheinen, aus dem die werte stammen deines makors also in dem ausgangsblatt nicht im auswertung blatt.

nein! der bereich auf den das min_max makro zugreifen soll ist beliebig groß, aber nur in spalte A also zb von A2 bis A65000

ABER:
bei meiner testdatei hat es funktioniert, ich habe nur keine ahnung wie ich es in mein orginal programm zum laufen bekomme.

gruß sebal

Antwort 12 von sebal vom 06.11.2019, 08:44 Options

ich möchte ja dass es bei % RES END endet

Antwort 13 von coros vom 06.11.2019, 08:50 Options

Hallo sebal,

Du hast mich falsch verstanden. Das Makro sucht nach Deinen Vorgaben also "%RES" und "%*" und macht dann etwas. Das Makro sucht in der Spalte A in dem Blatt mit den Originaldaten. Wenn Du nun schreibst, dass der Min- und Maxwert in der gleichen Spalte in Zelle A589 und A590 eingetragen werden sollen, gehe ich erst mal davon aus, dass die Daten, die durchsucht werden sollen, sich im Bereich A1 bis A588 befinden. Ist das richtig oder wird hier eventuell die falsche Spalte nach Deinen Kriterien durchsucht. Du musst schon ein paar Angaben zu Deiner Datei machen, denn ich kenne die natürlich nicht so wie Du.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 14 von sebal vom 06.11.2019, 08:52 Options

hallo oliver,

ich hab dir doch mein bisheriges programm gesendet,

das makor von dir funktioniert bei meiner testdatei, wie muss ich es nun in mein programm tun damit es hier ebenfalls funktioniert. ausserdem funktuioniert mein min_max makro bei der testdai ebenfalls, bin allerdings ebenfalls überfordert, wie ich es in mein orginal makro bekomme, so dass es funkioniert?

weist du da rat?
gruß sebal

Antwort 15 von coros vom 06.11.2019, 08:55 Options

Hallo sebal,

ich habe keine Datei von Dir. Bitte beantworte doch die Fragen, sonst sitzen wir hier noch ewig an dem Problem. Um Dir ein funktionierendes Makro hier hinzuschreiben, muss ich Antworten auf die Fragen haben.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 16 von sebal vom 06.11.2019, 08:56 Options

ach so, dann haben wir aneinader vorbei geredet, sorry!

nein, der bereich der durchsucht wrid endet bei %RES END kann jedoch auch bis Zelle A19000 oder so gehen. aber wie gesagt dien makro funktioniert bei meiner testdatei(die die ich in meiner frage am anfang steht).

also der minimum u maximum wert soll in Zelle AA589 bzw AA590 stehen, sorry mein fehler.

danke gruß sebal

Antwort 17 von coros vom 06.11.2019, 08:59 Options

Hallo Sebal,

wo sollen denn nun die beiden Werte erscheinen. Du schreibst in allen Beiträgen A589 und A590. Daher auch meine Frage, bis wo die Daten gehen könnten.. Nun schreibst Du aber AA589 und AA590. Was ist denn nun richtig?

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 18 von sebal vom 06.11.2019, 09:11 Options

hallo

die werte sollen nicht bis A589 oder AA589 gehen, sondern der min wert soll in AA589 stehen und der max wert soll in AA590 stehen.

der bereich der durchsucht werden soll ist abhängig von der datei in meinem beispeil das ich dir geschrieben habe ist der bereich den min_max makro durchsuchen soll A2:A8 in Auswertung, aber das ist wie gesagt variabel.

bei meinem min_max makro fukt es aber auch wenn ich A2:A30000 durchsuche obwohl nur bis A8 ein wert steht.

aber wie gesagt bei meiner testdatei die ich dir geschrieben habe fukt alles soweit nur in meiner orginaldatei gibts probs
sebal

Antwort 19 von coros vom 06.11.2019, 09:11 Options

Hallo sebal,

wenn es um die Zellen AA589 und AA590 geht, dann sieht das wie folgt aus.

Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.

[b]Option Explicit

Sub Suchen_und_kopieren()
Dim iRow As Long
Dim jRow As Long
Dim strAktSheet As String
Dim iSheets As Integer
Application.ScreenUpdating = False
strAktSheet = ActiveSheet.Name

For iSheets = Worksheets.Count To 1 Step -1
If Sheets(iSheets).Name = "Auswertung" Then
Application.DisplayAlerts = False
Sheets(iSheets).Delete
Application.DisplayAlerts = False
Exit For
End If
Next
With Worksheets.Add
.Name = "Auswertung"
End With

For iRow = 1 To Sheets(strAktSheet).Range("A65536").End(xlUp).Row
If Sheets(strAktSheet).Cells(iRow, 1) = "%RES END" Then GoTo Ende

If Sheets(strAktSheet).Cells(iRow, 1) = "%RES" Then
For jRow = iRow + 2 To Sheets(strAktSheet).Range("A65536").End(xlUp).Row
If Sheets(strAktSheet).Cells(jRow, 1) = "%*" Then
Sheets(strAktSheet).Range("A" & iRow + 2 & ":A" & jRow - 1).Copy
Sheets("Auswertung").Cells(Sheets("Auswertung").Range("A65536").End(xlUp).Offset(1, 0).Row, 1).PasteSpecial
Exit For
End If
Next jRow
End If
Next iRow
Ende:
Sheets(strAktSheet).Range("AA590") = Application.WorksheetFunction.Max(Sheets("Auswertung").Range("A2:A" & Sheets("Auswertung").Range("A65536").End(xlUp).Row))
Sheets(strAktSheet).Range("AA589") = Application.WorksheetFunction.Min(Sheets("Auswertung").Range("A2:A" & Sheets("Auswertung").Range("A65536").End(xlUp).Row))
End Sub[/b]



MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 20 von sebal vom 06.11.2019, 09:14 Options

hallo

in wie fern ändert sich dein am anfang geschriebenes makro wenn nicht die spalte A untersucht wird sondern %RES %* %RES END und alle werte in Spalte B stehen würden

sebal

Ähnliche Themen

Zellen verbinden in Excel - nicht möglich
canis  06.07.2007 - 290 Hits - 2 Antworten

Autofilter auslesen und ausgeben
Tomschi  23.08.2007 - 127 Hits -

Zellen mit textinhalt zusammenfassen???
Anlud  30.08.2007 - 103 Hits - 7 Antworten

Zellen nach gleichem Text überprüfen
Prain  04.10.2007 - 127 Hits - 9 Antworten

Farbwert auslesen!!!
Platin7  29.02.2008 - 55 Hits - 6 Antworten

Hinweis

Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..

Neue Einträge

Version: supportware 1.9.150 / 10.06.2022, Startzeit:Thu Jan 8 21:07:44 2026