VBA statt Formel kopieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hi,
vielleicht reicht auch eine dier Verkürzungen in I3:J3.

	G	H	I	J
3	cy	1	1	1
4	eee	0	0

Formeln der Tabelle

Zelle	Formel
H3	=WENN(G3="";"";WENN(ODER((G3="AT"); (G3="BE"); (G3="BG"); (G3="CY"); (G3="CZ"); (G3="DE"); (G3="DK"); (G3="EE"); (G3="ES"); (G3="FI"); (G3="FR"); (G3="GB"); (G3="GI"); (G3="GR"); (G3="HU"); (G3="IE"); (G3="IT"); (G3="LT"); (G3="LU"); (G3="LV"); (G3="MT"); (G3="NL"); (G3="PL"); (G3="PT"); (G3="RO"); (G3="SE"); (G3="SI"); (G3="SK"); (G3="UK")); 1;0))
I3	=WENN(G3="";"";--ISTZAHL(SUCHEN(G3&" ";"AT BE BG CY CZ DE DK EE ES FI FR GB GI GR HU IE IT LT LU LV MT NL PL PT RO SE SI SK UK ")))
J3	=WENN(LÄNGE(G3)<>2;"";--ISTZAHL(--(REST(SUCHEN(G3;"ATBEBGCYCZDEDKEEESFIFRGBGIGRHUIEITLTLULVMTNLPLPTROSESISKUK"); 2)=1)))

Es bleibst natürlich die grundsätzliche Frage, ob du in der Tabelle besser Formeln oder besser nur Werte stehen hast.
Formeln sind eher geeignet, wenn sich Daten in Spalte G ändern können - die Werte werden dann automatisch angepasst.
Kann sich in G nichts ändern, reichen die Formelwerte aus. Dann kann man sie berechnen lassen und dann mit
"Kopieren - Inhalte einfügen - Nur Werte" die Formeln durch Werte ersetzen. Das entschlackt die Mappe.
Ob sich ein VBA-Einsatz rentiert, hängt von deinen Kenntnissen ab und davon, wie oft dieser Vorgang stattfinden muss.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Sub Berechnen() Dim ArrayData, ArrayAusgabe() Dim oDic As Object Dim nCount As Long Set oDic = CreateObject("Scripting.Dictionary") With Sheets("Tabelle1") 'Tabelle anpassen .Range("J2", .Cells(.Rows.Count, 10)).ClearContents With .Range("G2", .Cells(.Rows.Count, 7).End(xlUp)) If .Cells(1, 1).Row > 1 Then FuellDictionary oDic ArrayData = .Cells.Resize(, 2) Redim Preserve ArrayData(1 To Ubound(ArrayData), 1 To 1) Redim Preserve ArrayAusgabe(1 To Ubound(ArrayData), 1 To 1) For nCount = 1 To Ubound(ArrayData) If ArrayData(nCount, 1) <> "" Then ArrayAusgabe(nCount, 1) = 0 If oDic.exists(ArrayData(nCount, 1)) Then ArrayAusgabe(nCount, 1) = 1 End If End If Next nCount .Offset(0, 3) = ArrayAusgabe End If End With End With End Sub Sub FuellDictionary(ByRef oDic As Object) Dim ZeichenArray, varData ZeichenArray = Array("AT", "BE", "BG", "CY", "CZ", "DE", "DK", _ "EE", "ES", "FI", "FR", "GB", "GI", "GR", "HU", _ "IE", "IT", "LT", "LU", "LV", "MT", "NL", "PL", _ "PT", "RO", "SE", "SI", "SK", "UK") For Each varData In ZeichenArray oDic(varData) = 0 Next End Sub

Sub RechneJ() Dim arrG, arrK, gg As Long, lngK As Long, kk As Long Dim arrAusgabe() With Sheets("Tabelle1") 'Tabelle anpassen lngK = .Cells(.Rows.Count, 10).End(xlUp).Row If lngK > 2 Then .Cells(2, 10).Resize(lngK - 1).ClearContents With .Cells(2, 7).Resize(.Cells(.Rows.Count, 7).End(xlUp).Row - 1) If .Cells(1, 1).Row > 1 Then ' Sort der Kürzel etwa nach Häufigkeit des Auftretens arrK = Split("DE NL PL AT BE BG CY CZ DK EE ES FI FR GB" & _ " GI GR HU IE IT LT LU LV MT PT RO SE SI SK UK") lngK = UBound(arrK) arrG = .Value ReDim arrAusgabe(1 To UBound(arrG)) For gg = 1 To UBound(arrG) If arrG(gg, 1) = "" Then arrAusgabe(gg) = "" Else For kk = 0 To lngK If arrG(gg, 1) = arrK(kk) Then Exit For Next kk arrAusgabe(gg) = -(kk > lngK) End If Next gg .Offset(0, 3) = Application.Transpose(arrAusgabe) End If End With End With End Sub

Sub Beispiel() Dim ArrayData(), ArrayAusgabe() Dim nCount As Long, DateHeute As Long With Sheets("Tabelle2") .Columns(11).ClearContents DateHeute = CLng(Date) ArrayData = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 2).Value2 Redim Preserve ArrayAusgabe(1 To Ubound(ArrayData), 1 To 1) For nCount = 1 To Ubound(ArrayData) If DateHeute - ArrayData(nCount, 1) = 0 Then ArrayAusgabe(nCount, 1) = 1 Else ArrayAusgabe(nCount, 1) = DateHeute - ArrayData(nCount, 1) End If Next nCount .Range("K1").Resize(Ubound(ArrayAusgabe), 1) = ArrayAusgabe End With End Sub

Hi
wenn ich wie du daß Problem habe, daß zwar eine Formellösung existiert, aber die die Formel die Datei gross und träge macht, dann löse ich das so, daß ich die Formel per Makro eintrage und dann die Formel durch ihren Wert ersetze.
das mache ich aus folgenden Gründen:
1. bin ich zu faul, die Formel als Makro nachzuprogrammieren
2. ist die Formellösung meist schneller und einfacher (nicht immer, aber oft) als eine reine Makrolösung (zumindes muss die Makrolösung mit viel KnowHow und aufwand programmiert werden, um besser zu sein als die Formel).
wenn du dich beispielsweise für die Lösung von Haja mit dem SVerweis entscheiden solltest, würde das als Makro so aussehen:

With Range("J3:J" & Cells(Rows.Count, 7).End(xlup).Row)
.FormulaLocal = "=WENN(G3="""";"""";WENNFEHLER(SVERWEIS(G3;$A$16:$B$44;2;0);0))"
.Formula = .Value
End With

oder so:

With Range("J3:J" & Cells(Rows.Count, 7).End(xlup).Row)
.FormulaLocal = "=WENN(G3="""";"""";WENNFEHLER(SVERWEIS(G3;$A$16:$B$44;2;0);0))"
.copy
.PasteSpecial xlpastevalues
.Application.CutCopyMode = False
End With

die 2. Methode ist etwas schneller, setzt aber die Markierung auf den Zellbereich, was manchmal störend ist.
bei .FormulaLocal kannst du die Formel so verwenden, wie sie in der ersten Zelle des Zellbereichs steht, lediglich die Anführungszeichen, die zur Formel gehören, müssen doppelt eingegeben werden ("" statt ")
Gruß, Daniel

Beliebteste Forumthreads (12 Monate)

verwendete Formeln
Zelle	Formel	Bereich
H3	=WENN(G3="";"";WENNFEHLER(SVERWEIS(G3;$A$16:$B$44;2;0);0))
H4	=WENN(G4="";"";WENNFEHLER(SVERWEIS(G4;$A$16:$B$44;2;0);0))
H5	=WENN(G5="";"";WENNFEHLER(SVERWEIS(G5;$A$16:$B$44;2;0);0))

35
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

310 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

	A	B
16	AT	1
17	BE	1
18	BG	1
19	CY	1
20	CZ	1
21	DE	1
22	DK	1
23	EE	1
24	ES	1
25	FI	1
26	FR	1
27	GB	1
28	GI	1
29	GR	1
30	HU	1
31	IE	1
32	IT	1
33	LZ	1
34	LU	1
35	LV	1
36	MT	1
37	NL	1
38	PL	1
39	PT	1
40	RO	1
41	SE	1
42	SI	1
43	SK	1
44	UK	1

	A	B
16	AT	1
17	BE	1
18	BG	1
19	CY	1
20	CZ	1
21	DE	1
22	DK	1
23	EE	1
24	ES	1
25	FI	1
26	FR	1
27	GB	1
28	GI	1
29	GR	1
30	HU	1
31	IE	1
32	IT	1
33	LZ	1
34	LU	1
35	LV	1
36	MT	1
37	NL	1
38	PL	1
39	PT	1
40	RO	1
41	SE	1
42	SI	1
43	SK	1
44	UK	1

VBA statt Formel kopieren

35 Beiträge zum Forumthread Beiträge zu diesem Forumthread

310 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

35
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

	A	B
16	AT	1
17	BE	1
18	BG	1
19	CY	1
20	CZ	1
21	DE	1
22	DK	1
23	EE	1
24	ES	1
25	FI	1
26	FR	1
27	GB	1
28	GI	1
29	GR	1
30	HU	1
31	IE	1
32	IT	1
33	LZ	1
34	LU	1
35	LV	1
36	MT	1
37	NL	1
38	PL	1
39	PT	1
40	RO	1
41	SE	1
42	SI	1
43	SK	1
44	UK	1