VBA - Werte in Tabellen Übertragen

[Andi_Koer_1234]

Hi,


Der CODE von Rabe ging leider nicht im bei mir, ich hatte einen Laufzeitfehler 431. Aber hier die Lösung:

Code:

Range("D3:D4").Interior.Color = 65535                    'Aktion 3: Färbe Zellenbereich Gelb ein
Range("D3:D4").Interior.Pattern = xlNone                 'Aktion 2: Entfärbe Zellenbereich

---

Achja und hat jemand eine Idee, wie man das löschen des Zelleninhaltes in meinem Code verhindern kann, wenn in der Quelle nix angegeben ist und ich eine Manuelle Eingabe der Grenzabmaße unter dem Ziel machen möchte.... ?

Ich lade mal die Datei dazu hoch.  Ist eine UND BEDINGUNG da Sinvoll oder gibt es da was besseres? Wie kann man so etwas aufbauen?


Gruß Andi

[atilla]

Hallo,

mit dem Change schmiert Excel ab, weil du hiermit:

Code:

If Not Range("$B$15") = "" Then
  Range("C15") = Range("B15")
  Range("C16") = Range("B16")
End If

eine Endlosschleife produziert hast.

Damit das nicht passiert gibt es den Befehl Application.EnableEvents, mit welchem das Ereignis ein und abgeschaltet werden kann. Siehe Online Hilfe.

[Rabe]

Hi Andi,

Der CODE von Rabe ging leider nicht im bei mir, ich hatte einen Laufzeitfehler 431. Aber hier die Lösung:

bei mir funktioniert es einwandfrei:

Private Sub Worksheet_Change(ByVal Target As Range)

  

  '--------------------------------------------------------------------------- Test 1 --------------------------------------------------------------------------- 

  If Target.Address = "$B$3" Then

     Cells(3, 3) = Cells(3, 2)

     Cells(4, 3) = Cells(4, 2)

  End If

  

  

  '--------------------------------------------------------------------------- Test 2 --------------------------------------------------------------------------- 

  If Target.Address = "$B$9" Then

     Range("C9") = Range("B9")

     Range("C10") = Range("B10")

  End If

  

  

  '--------------------------------------------------------------------------- Test 3 --------------------------------------------------------------------------- 

  '   If Range("B15") <> "" Then 

  '      Range("C15") = Range("B15") 

  '      Range("C16") = Range("B16") 

  '      Range("C15:C16").Locked = True 

  '      Range("C15:C16").FormulaHidden = False 

  '   Else 

  '      Range("C15:C16").Locked = False 

  '      Range("C15:C16").FormulaHidden = False 

  '   End If 

  

  'Selektieren und einfärben bzw. entfärben 

  If Not Range("$B$15") = "" Then

     Range("H7").Interior.Color = 65535

  Else

     Range("H7").Interior.Pattern = xlNone

  End If

End Sub

VBA/HTML - CodeConverter für Office-Foren, AddIn für Excel/Word 2000-2013 - komplett in VBA geschrieben von Lukas Mosimann. Projektbetreuung durch mumpel
Code erstellt und getestet in Office 15

[Rabe]

Hi Andi,

Ich lade mal die Datei dazu hoch.  Ist eine UND BEDINGUNG da Sinvoll oder gibt es da was besseres? Wie kann man so etwas aufbauen?

geht es eigentlich immer noch um die Grundfrage mit den Passungen, die Du im anderen Thema gestellt hast?

Hier dazu der oben schon gepostete Ausschnitt:

Tabelle2

	A	B	C	D	E	F	G	H	I	J	K	L	M
5	Protokoll								Passungsauswahl
6
7	Maß	Toleranz	ot	ut	gm	km			über	h5		j6
8	2	j6	4	-2	2,004	1,998			0	0	-4	4	-2
9	3	j6	6	-2	3,006	2,998			3	0	-5	6	-2
10	4	j5	#NV	#NV	#NV	#NV			6	0	-6	7	-2
11	7	j6	7	-2	7,007	6,998			10	0	-8	8	-3
12	15	j6	8	-3	15,008	14,997
13	11	h5	0	-8	11,000	10,992
14	6	h6	#NV	#NV	#NV	#NV
15	4	j6	6	-2	4,006	3,998

verwendete Formeln
Zelle	Formel	Bereich	N/A
C8:C15	=INDEX($J$8:$M$11;VERGLEICH(VERWEIS(9^9;1*[@Maß]);$I$8:$I$11;1);VERGLEICH(WECHSELN(B8;VERWEIS(9^9;1*[@Maß]);"";1);$J$7:$M$7;))
D8: D15	=INDEX($J$8:$M$11;VERGLEICH(VERWEIS(9^9;1*[@Maß]);$I$8:$I$11;1);VERGLEICH(WECHSELN($B8;VERWEIS(9^9;1*[@Maß]);"";1);$J$7:$M$7;)+1)
E8:F15	=VERWEIS(9^9;1*LINKS($A8;SPALTE(1:1)))+C8/1000

Excel-Inn.de

Hajo-Excel.de

XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007

Add-In-Version 19.08 einschl. 64 Bit

Wenn nein, vergiß das Folgende:
Ich verstehe nämlich gar nicht, was und warum Du da die ganze Zeit herumkopierst und Dich und uns unnötigerweise damit beschäftigst.
Du mußt doch erst mal Excel sagen, was überhaupt kopiert werden soll, das kopieren ist doch dann Pipifax.
So wie es jetzt ist, nimmt Excel die Daten, die Du in die Quelle eingibst und kopiert sie in die Zielzellen. Wenn Du die Toleranzen sowieso eingeben mußt, kannst Du sie auch gleich in das Ziel eingeben.

Du willst doch das Maß und die Toleranzbezeichnung eingeben und Excel soll dann die Toleranzwerte aus der DIN-Tabelle holen.

[snb]

Oder:

Code:

Range("H7").Interior.ColorIndex = Abs((Range("$B$15") <> "") * 5)

[Andi_Koer_1234]

Hallo,

alles erledigt, ist echt super geworden! Danke!

Gruß Andi