MS-Office-Forum

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Excel
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 08.11.2018, 08:22   #1
buchi99
Neuer Benutzer
Neuer Benutzer
Standard Excel 2013 - VBA Schleife in der Schleife

Hallo!

Hab mal wieder ein Problem:

Ich habe eine Liste in einen Tabellenblatt1, sagen wir Bereich B13:B20, diese Werte sollen mit Werten in einer anderen Tabellenblatt2 verglichen werden, A1:XX1, wenn ein Treffer vorhanden ist, z.B in C1 sollen die Zellen C5 und C6 kopiert werden. (wieder In Tabellenblatt1 neben den aktuellen Suchwert, also wenn er gerade den Wert von B13 gesucht hat soll es in c13:d13 kopiert werden.

Ich habe bis jetzt die Schleife nur so weit geschafft das er zu Tabellenblatt1 B13 geht und danch im anderen Tabellenblatt 2 die Werte absucht und auf Tabellenblatt 1 kopiert, ich komm aber nicht drauf wie er danach auf B14 hüpft und das gleiche von vorne macht.

Optimal wäre auch wenn er die Schleife nach einen Treffer beendet, bei mir sucht er immer bis zum Ende durch.


Danke



PHP-Code:

Sub test()

Dim Einheit As String
Dim Einheit1 
As String
Dim i 
As Integer
Dim b 
As Integer
1
13

Einheit 
Worksheets("Layout").Cells(b2)


Einheit1 Worksheets("REF1").Cells(1i)



1
For 1 To 100


If Einheit Einheit1 Then
    Worksheets
("REF1").Select
    Worksheets
("REF1").Range(Cells(41), Cells(51)).Select
    Selection
.Copy
    Worksheets
("Layout").Select
    Worksheets
("Layout").Cells(133).Select
    Selection
.PasteSpecial Paste:=xlPasteAllOperation:=xlNoneSkipBlanks:= _
        False
Transpose:=True
    
     End 
If
   
Einheit1 Worksheets("REF1").Cells(1i)
   
Next i


End Sub 
So schauen z.B die gesuchten Werte aus:

Code:

			
	MIN	MAX	
N			
P_61			
P_51			
NOX_EO			
PED			
T_OIL			
ECU_025
Und hier muß er suchen:

Code:

	S_DATE	ODA_TIM_05	N	BMEP	MD	HR_IA	BSFC	PED	T_OIL	T_W_O	ECU_025	T_IA	T_21	T_2_1	T_IM	T_31
			HR_IA	P_2_1	P_41											
																
Min			-1	-1	0	-0,3	15	**		20	20	20	-10	-6	-6	5
Max			1	1	5	0,3	25	**		30	30	30	5	5	5	20
Angehängte Dateien
Dateityp: xlsm TEST.xlsm (116,4 KB, 3x aufgerufen)

Geändert von buchi99 (08.11.2018 um 08:38 Uhr).
buchi99 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.11.2018, 09:16   #2
Beverly
MOF Guru
MOF Guru
Standard

Hi,

meinst du vielleicht so etwas:
Code:

Sub Uebertragen()
    Dim lngZeile As Long
    Dim rngSpalte As Range
    Dim wksTab As Worksheet
    Set wksTab = Worksheets("REF1")
    With Worksheets("Layout")
        For lngZeile = 13 To 19
            Set rngSpalte = wksTab.Rows(1).Find(.Cells(lngZeile, 2), lookat:=xlWhole)
            If Not rngSpalte Is Nothing Then
                wksTab.Range(wksTab.Cells(4, rngSpalte.Column), wksTab.Cells(5, rngSpalte.Column)).Copy
                .Cells(lngZeile, 3).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                    False, Transpose:=True
            End If
        Next lngZeile
    End With
End Sub

GrußformelBeverly's Excel - Inn

__________________

Bitte im Beitrag eine kurze Rückmeldung auch in dem Fall geben, wenn ein Problem gelöst wurde - dies hilft auch anderen Usern, wenn sie den betreffenden Thread lesen.
Möchtest du dich außerdem für die Hilfe bei der Lösung deines Problems bedanken? Das kannst du ganz einfach durch die Bewertung eines Beitrags (Schalter unten links).
Beverly ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 09.11.2018, 06:34   #3
buchi99
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Ja genau das funktioniert!


Leider wieder mal traurig für mich das jemand der sich auskennt von meinen Code nix verwenden kann.....

Wenn du noch Zeit hättest, könntest du mir deinen Code noch erklären?

Warum benennst du die Zeile as long
und die Spalte as range?


Und evtl. eine kurze Zusammenfassung was das eigentlich bedeutet:

Set rngSpalte = wksTab.Rows(1).Find(.Cells(lngZeile, 2), lookat:=xlWhole)
If Not rngSpalte Is Nothing Then
wksTab.Range(wksTab.Cells(4, rngSpalte.Column), wksTab.Cells(5, rngSpalte.Column




Dankeee!


PS: Nur eine kleine Änderung vielleicht noch, ich hätte noch gerne das er eine Unterscheidung zwischen groß und kleinschreibung macht, sprich wenn das Suchergebnis MD ist soll er mir nicht die Werte von md ausgeben, soetwas kann nämlcih auch vorkommen.

Muß man das Suchwort irgendwo als String definieren?

Geändert von buchi99 (09.11.2018 um 06:53 Uhr).
buchi99 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 09.11.2018, 08:31   #4
Jadzia_Dax
MOF User
MOF User
Standard

Hallo buchi99,

die Frage wegen der Groß- und Kleinschreibung hast Du mir am 02.11. per PN gestellt und am gleichen Tag eine Antwort erhalten :

Zitat:

Hallo buchi99,

Du musst bei der find-Methode nur ein Kriterium für Groß- und Kleinschreibung ergänzen. Ergänze in der find-Zeile mal das MatchCase:= true

Code:

Set c = .Find(ws2.Range("A" & r2), LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
LG Dax

Mit der find-Methode suchst Du eine "Zelle", dementsprechend muss die Variable (in Beverlys Code: rngSpalte) als Range definiert werden. Danach sprichst Du dann die Spaltennr. dieser Zelle mit rngSpalte.Column und die Zeilennr. mit rngSpalte.Row an.
Long bedeutet: Ganzzahlen -2.147.483.648 bis 2.147.483.647

Zitat:

Set rngSpalte = wksTab.Rows(1).Find(.Cells(lngZeile, 2), lookat:=xlWhole)

Sucht in Zeile 1 des worksheets wksTab den Wert der Zelle "B"&lngZeile des worksheets "Layout". "xlwhole" bedeutet, dass der gesamte Zellinhalt übereinstimmen muss.

Warum nutzt Du die Codetags nicht ? Mister Burns hat Dir doch extra einen Screen gemacht, wie Du das machst.

LG Dax
Jadzia_Dax ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 09.11.2018, 09:11   #5
hary
MOF Guru
MOF Guru
Standard

Moin
Hatte auch schon einen Code fertig, nur war Beverly schneller.
Hier mal meinen auskommentiert.
Code:

Sub TestA()
Dim wksQ As Worksheet, wksZ As Worksheet
Dim Bereich As Range, Zelle As Range, rngFind As Range
'-- mit Set wird ein Objekt erstellt,so kann man z.B. "wksZ" statt Worksheets("Layout")....
'-- ... im Code verwenden. Spart schreiberei.
Set wksZ = Worksheets("Layout")
Set wksQ = Worksheets("REF1")
'--Bildschirm Aktuellisierung aus / verhindert flackern
Application.ScreenUpdating = False
'--Teil hinter "=": wksZ Range geht von B13 bis letzte benutze Zelle in SpalteB
Set Bereich = wksZ.Range("B13:B" & wksZ.Cells(Rows.Count, 2).End(xlUp).Row)
'--abklappern jeder Zelle im Bereich
For Each Zelle In Bereich
'-- sucht in wksQ Zeile 1 / MatchCase:=True heisst Gross-/Kleinschreibung beachten
  Set rngFind = wksQ.Rows(1).Find(Zelle, lookat:=xlWhole, MatchCase:=True)
'-- wenn gefunden
    If Not rngFind Is Nothing Then
'-- Trefferzelle 3 Zeilenrunter und um incl. der Zelle 2 Zeilen erweitern und kopieren
      rngFind.Offset(3, 0).Resize(2, 1).Copy
'-- Suchzelle("Offset(0, 1)") eine Spalte nach rechts einfuegen
      Zelle.Offset(0, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    End If
Next
'--Bildschirm Aktuellisierung ein
Application.ScreenUpdating = True
Set wksZ = Nothing
Set wksQ = Nothing
Set Bereich = Nothing
Set rngFind = Nothing
End Sub
gruss hary
hary ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 09.11.2018, 09:19   #6
Beverly
MOF Guru
MOF Guru
Standard

Man kann dein Problem auch in zwei verschachtelten Schleifen lösen, indem man in der äußeren Schleife (wie gehabt) über die Zeilen im Tabellenblatt 2Layout" und in der inneren spaltenweise über die Zellen in Zeile 1 im Tabellenblatt "REF1" läuft:

Code:

Sub Uebertragen()
    Dim lngZeile As Long
    Dim intSpalte As Integer
    Dim wksTab As Worksheet
    Set wksTab = Worksheets("REF1")
    With Worksheets("Layout")
        ' Schleife über die Zeilen 13 bis 19
        For lngZeile = 13 To 19
            ' Schleife über die Spalten 4 bis 52
            For intSpalte = 4 To 52
                If wksTab.Cells(1, intSpalte) = .Cells(lngZeile, 2) Then
                    wksTab.Range(wksTab.Cells(4, intSpalte), wksTab.Cells(5, intSpalte)).Copy
                    .Cells(lngZeile, 3).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                        False, Transpose:=True
                    ' innere Schleife verlassen um Zeit zu sparen
                    Exit For
                End If
            Next intSpalte
        Next lngZeile
    End With
End Sub
Die innere Schleife kann man etwas verkürzen, indem man - nachdem die Zelle (in Zeile 1) der laufenden Spaltennummer mit dem gewünschten Begriff übereinstimmt - diese Schleife verlässt und mit der äußeren Schleife fürtfährt. Dennnoch beanspruchst die innere Schleife unnötig viel Zeit, insbesondere dann wenn der Suchbegriff nicht vorhanden ist, wird sie trotzdem und sinnloserweise bis zur letzten Spalte durchlaufen.

Um diesen Prozess der inneren Schleife zu umgehen verwendet man die Find-Methode, die aber nicht mit der Spaltennummer (als Integer) sondern mit der Zelle als Range arbeitet und bei der direkt zum Suchbegriff "gesprungen" wird (falls dieser vorhanden ist). Falls der Suchbegriff jedoch nicht vorhanden ist, bleibt die Set-Variable leer und das würde beim Kopieren zu einem Laufzeitfehler führen. Deshalb prüft man, ob die Zelle mit dem Suchbegriff gefunden wurde und das geschieht in der If-Abfrage

Code:

If Not rngSpalte Is Nothing Then
Und wenn diese sozusagen "positiv beantwortet" wird, erst dann wird kopiert.


GrußformelBeverly's Excel - Inn

__________________

Bitte im Beitrag eine kurze Rückmeldung auch in dem Fall geben, wenn ein Problem gelöst wurde - dies hilft auch anderen Usern, wenn sie den betreffenden Thread lesen.
Möchtest du dich außerdem für die Hilfe bei der Lösung deines Problems bedanken? Das kannst du ganz einfach durch die Bewertung eines Beitrags (Schalter unten links).
Beverly ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 09.11.2018, 19:40   #7
buchi99
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

danke an alle für eure erklärungen und hilfe.

ich beschäftige mich erst seit ein paar wochen mit excel also habt bitte auch noch weiterhin in bischen nachsicht für meine vielleicht etwas dummen fragen. aber zumindest ich sehe einen kleinen fortschritt bei mir.

danke nochmal und
LG Buchi
buchi99 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 09.11.2018, 22:44   #8
Beverly
MOF Guru
MOF Guru
Standard

Mal ganz am Rande und nicht persönlich gemeint: dumme Fragen gibt es nicht, im Gegenteil - wer nicht fragt, bleibt dumm...


GrußformelBeverly's Excel - Inn

__________________

Bitte im Beitrag eine kurze Rückmeldung auch in dem Fall geben, wenn ein Problem gelöst wurde - dies hilft auch anderen Usern, wenn sie den betreffenden Thread lesen.
Möchtest du dich außerdem für die Hilfe bei der Lösung deines Problems bedanken? Das kannst du ganz einfach durch die Bewertung eines Beitrags (Schalter unten links).
Beverly ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 12:09 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.