Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.04.2024 18:57:33
17.04.2024 16:56:58
Anzeige
Archiv - Navigation
1228to1232
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
Inhaltsverzeichnis

Formel gesucht (VBA?)

Formel gesucht (VBA?)
Thomas
Hallo Excelfreunde,
ich habe mir einen Wolf gesucht und nichts passendes dabei gefunden. Ich suche eine Formel die mir alle Werte größer/gleich 1050 aus Tabelle 1 A4:A20 die von Hand dort eingetragen sind in Tabelle 2 ab G8 untereinander schreibt. Die Werte können mehrfach in dem Bereich der Tabelle 1 vorkommen und sie ist unsortiert und muss es bleiben, falls wichtig.
Zudem brauch ich noch die Werte aus den Spalten C:E aus der Zeile wo der Wert gefunden wird.
Mit freundlichen Grüßen
Thomas
AW: Formel gesucht (VBA?)
18.09.2011 12:33:28
Hajo_Zi
Hallo Zhomas,
warum benutzt Du nicht Autofilter und kopierst den sichtbaren Bereich?

AW: Formel gesucht (VBA?)
18.09.2011 13:19:22
fcs
Hallo Thomas,
Formel-Lösung
Tabelle2

 GHIJ
7Spalte ASpalte CSpalte DSplate E
81070C5D5E5

Formeln der Tabelle
ZelleFormel
G8{=WENN(SUMMENPRODUKT((Tabelle1!$A$4:$A$20>=1050)*1)>=ZEILE($A1); INDEX(Tabelle1!$A$4:$E$20;KKLEINSTE(WENN(Tabelle1!$A$4:$A$20>=1050;ZEILE(Tabelle1!$A$4:$A$20)-ZEILE($A$4)+1;999); ZEILE($A1)); 1); "")}
H8{=WENN(SUMMENPRODUKT((Tabelle1!$A$4:$A$20>=1050)*1)>=ZEILE($A1); INDEX(Tabelle1!$A$4:$E$20;KKLEINSTE(WENN(Tabelle1!$A$4:$A$20>=1050;ZEILE(Tabelle1!$A$4:$A$20)-ZEILE($A$4)+1;999); ZEILE($A1)); 3); "")}
I8{=WENN(SUMMENPRODUKT((Tabelle1!$A$4:$A$20>=1050)*1)>=ZEILE($A1); INDEX(Tabelle1!$A$4:$E$20;KKLEINSTE(WENN(Tabelle1!$A$4:$A$20>=1050;ZEILE(Tabelle1!$A$4:$A$20)-ZEILE($A$4)+1;999); ZEILE($A1)); 4); "")}
J8{=WENN(SUMMENPRODUKT((Tabelle1!$A$4:$A$20>=1050)*1)>=ZEILE($A1); INDEX(Tabelle1!$A$4:$E$20;KKLEINSTE(WENN(Tabelle1!$A$4:$A$20>=1050;ZEILE(Tabelle1!$A$4:$A$20)-ZEILE($A$4)+1;999); ZEILE($A1)); 5); "")}
Enthält Matrixformel:
Umrandende
{ } nicht miteingeben,
sondern Formel mit STRG+SHIFT+RETURN abschließen!
Matrix verstehen


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Die Formeln in Zeile 8 kannst du dann nach unten kopieren
Makro-Lösung Sub WerteVergleichen_Uebertragen() Dim wksQuelle As Worksheet Dim wksZiel As Worksheet Dim ZeileQ As Long, ZeileQ1 As Long, SpalteQS As Long Dim ZeileZ As Long, ZeileZ1 As Long, SpalteZ1 As Long Set wksQuelle = ActiveWorkbook.Worksheets(1) 'oder auch Worksheets("Tabelle1") ZeileQ1 = 4 'Zeile ab der Werte in Quelle verglichen werden sollen SpalteQS = 1 'Spalte in der Werte in Quelle verglichen werden sollen - Spalte A Set wksZiel = ActiveWorkbook.Worksheets(2) 'oder auch Worksheets("Tabelle2") ZeileZ1 = 8 'Zeile ab der Werte eingetragen werden sollen SpalteZ1 = 7 'Zielspalte für gefundene Werte - Spalte G 'Altdaten im Zielblatt löschen With wksZiel ZeileZ = .Cells(.Rows.Count, 1).End(xlUp).Row If ZeileZ >= ZeileZ1 Then .Range(.Cells(ZeileZ1, 1), .Cells(ZeileZ, 4)).ClearContents End If ZeileZ = ZeileZ1 - 1 End With With wksQuelle For ZeileQ = ZeileQ1 To 20 If .Cells(ZeileQ, SpalteQS).Value >= 1050 Then ZeileZ = ZeileZ + 1 'Treffer ins Zielblatt eintragen wksZiel.Cells(ZeileZ, SpalteZ1).Value = .Cells(ZeileQ, SpalteQS).Value 'Weiter Daten aus Trefferzeile übertragen wksZiel.Cells(ZeileZ, SpalteZ1 + 1).Value = .Cells(ZeileQ, 3).Value 'Spalte C nach H wksZiel.Cells(ZeileZ, SpalteZ1 + 2).Value = .Cells(ZeileQ, 4).Value 'Spalte D nach I wksZiel.Cells(ZeileZ, SpalteZ1 + 3).Value = .Cells(ZeileQ, 5).Value 'Spalte E nach J End If Next End With wksZiel.Activate End Sub
Gruß
Franz
Anzeige
AW: Formel gesucht (VBA?)
18.09.2011 14:19:01
Thomas
Hallo zusammen,
erst mal Danke an Euch alle.
Hajo, die Tabelle ist eine Liste die so dann gedruckt wird und die Werte sollen automatisch in die andere Tabelle wo dann eine weiter Tabelle also ein weiteres Produkt erstellt wird und alle Tabellen in der Mappe ergibt ein Auftrag.
Herby, Dein Code funktioniert prima aber es sollte ohne Butten übertragen werden.
Franz, bei Deiner Formel frag ich mich was in A1 und in A4 drin stehen soll/muss? Dein Code muss ich noch Testen.
Gruß Thomas
AW: Formel gesucht (VBA?)
18.09.2011 14:45:27
Thomas
Hallo Franz,
Dein Code geht soweit auch nur wie bei Herby soll es ohne was zu machen übertragen werden und im Zielbereich werden nicht alle alten Werde gelöscht wenn es weniger Werte gibt die größer sind.
Gruß Thomas
Anzeige
AW: Formel gesucht (VBA?)
18.09.2011 23:05:10
fcs
Hallo Thomas,
hier ein korrigierter Code zum Löschen der Altdaten. Da stimmten die Spaltennummern nicht. Bei automatisiertem Start des Makros bei Änderungen in Blatt 1 sollte dann das Zielblatt zum Schluss micht aktiviert werden.
Um das Makro automatisch zu starten kann man mit dem Change-Ereignis Eingaben im relevanten Zellen im Tabellblatt "Tabelle12" überwachen und nach einer Änderung jeweils das Makro starten. Alternativ kann man nach jeder Berechnung im Blatt 1 auch das Makro ausführen, um die Daten im Blatt 2 zu aktualisieren.
In den Formeln muss in A1 und A4 nichts stehen, bzw. es ist egal was. Die Zellen werden ja "nur" in die Funktion ZEILE eingesetzt um einen Zahlenwert zurückzugeben.
Du kannst auch eine beliebeige andere Spalte verwenden. wichtig sit, dass die Zeilennummern stimmen.
Gruß
Franz

'Eines dieser beiden Makros im VBA-Editor unter der "Tabelle1" einfügen
'Wenn im Bereich A4:A20 und/oder C2:E20 die Werte per Formel berechnet werden
Private Sub Worksheet_Calculate()
Application.EnableEvents = False
Call WerteVergleichen_Uebertragen
Application.EnableEvents = True
End Sub
'oder
'Wenn in allen betroffenen Zellen Eingaben manuell gemacht werden
Private Sub xxWorksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A4:A20")) Is Nothing _
Or Not Intersect(Target, Range("C4:E20")) Is Nothing Then
Application.EnableEvents = False
Call WerteVergleichen_Uebertragen
Application.EnableEvents = True
End If
End Sub
Sub WerteVergleichen_Uebertragen()
Dim wksQuelle As Worksheet
Dim wksZiel As Worksheet
Dim ZeileQ As Long, ZeileQ1 As Long, SpalteQS As Long
Dim ZeileZ As Long, ZeileZ1 As Long, SpalteZ1 As Long
Set wksQuelle = ActiveWorkbook.Worksheets(1) 'oder auch  Worksheets("Tabelle1")
ZeileQ1 = 4   'Zeile ab der Werte in Quelle verglichen werden sollen
SpalteQS = 1  'Spalte in der Werte in Quelle verglichen werden sollen - Spalte A
Set wksZiel = ActiveWorkbook.Worksheets(2) 'oder auch  Worksheets("Tabelle2")
ZeileZ1 = 8   'Zeile ab der Werte eingetragen werden sollen
SpalteZ1 = 7  'Zielspalte für gefundene Werte - Spalte G
'Altdaten im Zielblatt löschen
With wksZiel
ZeileZ = .Cells(.Rows.Count, SpalteZ1).End(xlUp).Row
If ZeileZ >= ZeileZ1 Then
.Range(.Cells(ZeileZ1, SpalteZ1), .Cells(ZeileZ, SpalteZ1 + 3)).ClearContents
End If
ZeileZ = ZeileZ1 - 1
End With
With wksQuelle
For ZeileQ = ZeileQ1 To 20
If .Cells(ZeileQ, SpalteQS).Value >= 1050 Then
ZeileZ = ZeileZ + 1
'Treffer ins Zielblatt eintragen
wksZiel.Cells(ZeileZ, SpalteZ1).Value = .Cells(ZeileQ, SpalteQS).Value
'Weiter Daten aus Trefferzeile übertragen
wksZiel.Cells(ZeileZ, SpalteZ1 + 1).Value = .Cells(ZeileQ, 3).Value 'Spalte C nach H
wksZiel.Cells(ZeileZ, SpalteZ1 + 2).Value = .Cells(ZeileQ, 4).Value 'Spalte D nach I
wksZiel.Cells(ZeileZ, SpalteZ1 + 3).Value = .Cells(ZeileQ, 5).Value 'Spalte E nach J
End If
Next
End With
End Sub

Anzeige
AW: Formel gesucht (VBA?)
19.09.2011 17:49:13
Thomas
Hallo Franz,
hab den zweiten Code in die Tabelle rein gemacht wo ich die Werte von Hand eintrage. Stutzig machte mich das "xx" vor Worksheet_Change hab sie weg gemacht. Nun kommt der Fehler Sub oder Function nicht difiniert.
Hab geschaut ob alles richtig geschrieben ist aber diese Zeile wird mir angezeigt
"Call WerteVergleichen_Uebertragen"
Den Hauptcode hab ich in der anderen Tabelle ersetzt und wenn ich den Code aus dem Editor Starte löscht oder übertägt er alles nur der Fehler da hängt es dann.
Gruß Thomas
AW: Formel gesucht (VBA?)
20.09.2011 02:11:18
fcs
Hallo Thomas,
der Hauptcode gehört in ein allgemeines Modul.
Gruß
Franz
Anzeige
AW: Formel gesucht (VBA?)
20.09.2011 16:49:35
Thomas
Hallo Franz,
den kleinen Code habe ich in ein Modul gepackt aber den Hauptcode hatte ich nicht versucht g, da hätte ich den versuch auch noch machen können. Wieder was dazu gelernt erst alle möglichkeiten versuchen.
Was nervt ist das die Zieltabelle jedes mal aktiv wird.
Geht das auch ohne das die Tabelle nach jedem Wert aktiv wird?
Gruß Thomas
AW: Formel gesucht (VBA?)
20.09.2011 17:27:13
fcs
Hallo Thomas,
suche in der Hauptprozedur mal nach
wksZiel.Activate
Diese Zeile(n) löschen. Ich dachte, die hatte ich schon gelöscht gehabt.
Gruß
Franz
AW: Formel gesucht (VBA?)
20.09.2011 18:20:50
Thomas
Hallo Franz,
ich habs hin bekommen das hab ich eigendlich kurz darauf geschieben aber irgend wie hat es wohl nicht funktioniert. Code funzt prima dank dir.
Franz eine Frage kann ich nun eine andere Frage/Problem hier in dem Beitrag stellen was nun nicht mit Formel gesucht zu tun hat sondern mit Drucken oder soll ich es neu ins Forum stellen so das die anderen ggf auch davon was haben?
Gruß Thomas
Anzeige
AW: Formel gesucht (VBA?)
21.09.2011 00:24:19
fcs
Hallo Thomas,
wenn es um das gleiche Tabellenblatt geht, dann stelle die Frage zum Drucken hier, ändere aber die Betreff-Zeile.
Manchmal ist es wichtig zu wissen was in einem Tabellenblatt oder einer Arbeitsmappe schon alles so passiert.
Du kannst aber auch neu Fragen und fügst in der Frage einen Link auf diesen Thread ein.
Gruß
Franz
Drucken von Tabellen wenn
21.09.2011 16:50:07
Tabellen
Hallo Franz,
also dann stelle ich hier die Frage/ Problem.
Folgenden, meine Mappe hat 5 Tabs. Tab 1-3 sollen immer gedruckt werden bei Click das Tab 4 soll erst
mit gedruckt werden wenn in Tab 1 A4:A20 der Wert 1050 oder Größer steht. Das Tab 5 soll mitgedruckt werden wenn im Tab 1 A4:A20 der Wert 1050 oder Größer und in C4:C20 1800 oder größer steht.
Das Tab 1 ist im Querformat und Tab 5 auch wenn das wichtig sein sollte.
Die Druckbereiche sind verschieden also nicht immer beginnend bei A1, daher sollte ich die Druckbereiche der Blätter anpassen können (A4:J20) zb. Oder reicht es wenn ich in jedem Blatt den Druckbereich festlege?
Gruß Thomas
Anzeige
AW: Drucken von Tabellen wenn
21.09.2011 22:41:06
Tabellen
Hallo Thomas,
hier ein Makro das beim Klick auf Drucken oder Seitenvorschau den Standarddruck abbricht und die entsprechenden Blätter gruppiert druckt.
Den Druckereich kannst du in den Tabellenblättern individuell festlegen, Quer- und Hoch-Format spielt keine Rolle. Unterschiedliche Blattformate werden relevant, wenn in PDF-Dateien gedruckt wird, bei einigen PDF-Druckern muss man dann mit der Multidoc-Funktion arbeiten oder den Druck in mehreren Dateien speichern.
Gruß
Franz

'Code unter DieseArbeitsmappe
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim wks1 As Worksheet, wksAktiv As Worksheet
Dim arrSheets As Variant, intSheet As Integer
Cancel = True
Application.EnableEvents = False
Set wksAktiv = ActiveSheet
Set wks1 = Me.Worksheets(1) 'oder Me.Worksheets("Tabelle1")
Select Case Application.WorksheetFunction.Max(wks1.Range("A4:A20"))
Case Is >= 1050
If Application.WorksheetFunction.Max(wks1.Range("C4:C20")) >= 1080 Then
arrSheets = Array(1, 2, 3, 4, 5)
Else
arrSheets = Array(1, 2, 3, 4)
End If
Case Else
arrSheets = Array(1, 2, 3)
End Select
'Gruppiert drucken
Sheets(arrSheets).PrintOut preview:=True
'  SelectedSheets
Application.EnableEvents = True
wksAktiv.Select
End Sub

Anzeige
AW: Drucken von Tabellen wenn
22.09.2011 17:57:10
Tabellen
Hallo Franz,
hab den Code in Diese Arbeitsmappe gemacht und so angepasst.
Me.Worksheets("Türenstückliste") und
arrSheets = Array("Türenstückliste", "Blech aussen", "Blech innen", "Versteifung", "Winkeleisen") usw.
Franz es funktzioniert bis auf den Teil, da hast was überlesen. Das letzte Blatt soll nur gedruckt werden wenn in beiden Spalten die Bedingung erfüllt ist (WENN UND dann Drucken)
>>Das Tab 5 soll mitgedruckt werden wenn im Tab 1 A4:A20 der Wert 1050 oder Größer und in C4:C20 1800 oder größer steht.<<
Info: Hab meine Formeln aus meinem letzten Batt genommen und hab den Code was im Modul 1 ist in ein weiters Modul Kopiert und angepasst. Den einen Code um diese Zeile erweitert
>Call WerteVergleichen_Uebertragen1
und es überträgt, muss noch schauen wegen dem Bereich löschen da hab ich noch was zum nachbessern da bleibt noch was stehen.
Aber bisher 1000 Dank.
Gruß Thomas
Anzeige
AW: Drucken von Tabellen wenn
22.09.2011 20:37:12
Tabellen
Hallo Thomas,
Franz es funktzioniert bis auf den Teil, da hast was überlesen.
Ich hab es nicht überlesen, sondern nicht so verstanden, wie du es gerne hättest. ;-)
Im Moment wird Tab5 gedruckt, wenn in einer der Zellen im Bereich A4:A20 1050 steht und wenn in einer der Zellen im Bereich C4:C20 1080 steht.
>>Das Tab 5 soll mitgedruckt werden wenn im Tab 1 A4:A20 der Wert 1050 oder Größer und in C4:C20 1800 oder größer steht. Mit der folgenden Anpassung/Ergänzung wird Tab5 gedruckt, wenn in einer 17 Zeilen die Bedingung erfüllt wird. Geändert hat sich die If-Bedingung und die Function ist dazugekommen.
Gruß
Franz

'Code unter DieseArbeitsmappe
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim wks1 As Worksheet, wksAktiv As Worksheet
Dim arrSheets As Variant, intSheet As Integer
Cancel = True
Application.EnableEvents = False
Set wksAktiv = ActiveSheet
Set wks1 = Me.Worksheets(1) 'oder Me.Worksheets("Tabelle1")
Select Case Application.WorksheetFunction.Max(wks1.Range("A4:A20"))
Case Is >= 1050
If fncVergleich(Bereich1:=wks1.Range("A4:A20"), _
Bereich2:=wks1.Range("C4:C20"), _
vWert1:=1050, _
vWert2:=1080) = True Then
arrSheets = Array(1, 2, 3, 4, 5)
Else
arrSheets = Array(1, 2, 3, 4)
End If
Case Else
arrSheets = Array(1, 2, 3)
End Select
'Gruppiert drucken
Sheets(arrSheets).PrintOut preview:=True
'  SelectedSheets
Application.EnableEvents = True
wksAktiv.Select
End Sub
Private Function fncVergleich(ByVal Bereich1 As Range, _
ByVal Bereich2 As Range, ByVal vWert1, ByVal vWert2) As Boolean
'Prüft, ob für eine Zeile in den  beiden Bereichen gilt
'Wert in Bereich1 >= vWert1 UND Wert in Bereich2 >=  vWert2
Dim Zeile As Long
For Zeile = 1 To Bereich1.Rows.Count
If IsNumeric(Bereich1.Cells(Zeile, 1).Value) _
And IsNumeric(Bereich2.Cells(Zeile, 1).Value) Then
If Bereich1.Cells(Zeile, 1).Value >= vWert1 _
And Bereich2.Cells(Zeile, 1).Value >= vWert2 Then
fncVergleich = True
Exit For
End If
End If
Next
End Function

Anzeige
AW: Drucken von Tabellen wenn
23.09.2011 14:28:22
Tabellen
Hallo Franz,
es funktioniert nun hab nur den Wert von dir (1080) auf meinen Wert 1800 geändert :).
Ist ganz einfach, wenn die Türe breiter ist wie 1050 mm dann brauch ich 2-3 Querversteifungen im Türblatt somit muss Tab 4 gedruckt werden. Ist die Türbreite 1050 mm oder mehr und die Türlänge 1800 mm oder mehr so brauch ich noch ein Winkeleisen auf der Scharnierseite weil das Rahmenprofil nur 0,8 mm stark ist.
Habe heute meinen Auftrag mit 15 Türen (1293/2183) zum Pulvern fertig gestellt, da wiegt ein Türblatt schlappe 80 kg und das die Türe auch hält wird Blatt 5 mit gedruckt als Zuschnittsblatt mit Länge und Stückzahl.
Nun schau ich noch nach einer Formel wie Summenprodukt oder Vergleich und Summenprodukt. (gleiche Längen im Bereich die Stückzahlen zusammen Zählen)
Aber das versuch ich zunächst mal alleine.
Nochmal vielen Dank und ich wünsche Dir ein schönes We.
Gruß Thomas

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige