VBA - Werte in Tabellen Übertragen
#11
Hallo,
 
Also ich habe mal angefangen was aus zu probieren. Ich bin leider noch nicht so weit mich in andere Codes herein denken zu können... Habe wohl echt gemeint so etwas wäre leichter! Respekt erstmal wie Ihr das macht obwohl ich euch (glaube ich mal zumindest) auf den KEKS gehe.
 
Jetzt habe ich mir gedacht, ich mache erst mal folgendes:
Wenn NICHT in der Quelle der Grenzabmaße "" bzw. NICHTS steht, dann Übernehme die Maße aus den Bereichen "XYZ" und sperre die Zellen...  Ansonsten gebe die Zellen frei.
 
[Dazu muss ich noch sagen, die  Werte der Grenzabmaße, also die Quellwerte, werden in meiner Excel Datei nur Errechnet, wenn Passung und Durchmesser angegeben wurden via Formel, ansonsten steht da nix außer die hinterlegte Formel]

 
Allerdings bekomme ich in meiner Version immer einen Laufzeitfehler '9'. (Siehe Bild im Anhang  [Test 3])


Code:
'--------------------------------------------------------------------------- Test 3 ---------------------------------------------------------------------------
If Not Sheets("Tabelle9").Range("B15:B16").Value = "" Then
   Range("C15") = Range("B15")
   Range("C16") = Range("B16")
   Range("C15:C16").Select
   Selection.Locked = True
   Selection.FormulaHidden = False
       Else
       Range("C15:C16").Select
       Selection.Locked = False
       Selection.FormulaHidden = False

End If
End Sub


Probleme an dem Code (Wenn er denn Funktionieren würde):

Nachdem einmal automatisch abgerufene Grenzabmaße drin gestanden haben, bleiben diese Werte stehen auch wenn eine Manuelle Eingabe erfolgen kann, da die Passung 'abgewählt' wurde. Es wäre schöner, wenn die Grenzabmaße verschwinden, sobald keine Passung mehr angegeben wurde. Danach sollten natürlich, wenn man Manuelle Grenzabmaße eingibt, diese stehen bleiben, bis man diese Werte entweder löscht oder sich doch noch für eine Passung entscheidet.



Ich hoffe alles war verständlich für euch und Ihr gebt mich nicht auf,  :19:

Gruß
Andi


Angehängte Dateien Thumbnail(s)
   
Top
#12
Ergänzung

Achja: das Bild ist wichtig, dort kann man erkennen, welche Tabellen ich habe und wo die Zellen sind etc.
Top
#13
Hi!
Ein Bild ist hübsch, Deine Datei wäre hübscher ...
Die relevante Tabelle hat den Namen "Makro Test" sowie den Codenamen Tabelle9.
Also entweder Worksheets("Makro Test").Range
oder Tabelle9.Range

Gruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag. 
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
[-] Folgende(r) 1 Nutzer sagt Danke an RPP63 für diesen Beitrag:
  • Andi_Koer_1234
Top
#14
(05.12.2015, 15:11)RPP63 schrieb: Hi!
Ein Bild ist hübsch, Deine Datei wäre hübscher ...
Die relevante Tabelle hat den Namen "Makro Test" sowie den Codenamen Tabelle9.
Also entweder Worksheets("Makro Test").Range
oder Tabelle9.Range

Gruß Ralf

Ok, na dann mal hier die Datei!

Achja Der Tipp hat funktionierert! Nun kommt aber Laufzeitfehler 13...


Gruß
Andi


Angehängte Dateien
.xlsm   Mappe1.xlsm (Größe: 16,77 KB / Downloads: 3)
Top
#15
(05.12.2015, 17:04)Andi_Koer_1234 schrieb: Ok, na dann mal hier die Datei!

Achja Der Tipp hat funktionierert! Nun kommt aber Laufzeitfehler 13...


Gruß
Andi

Ergänzung:
In der Beispiel Mappe muss man einfach die Quell-Grenzmaße unter der Spalte B manuell ändern.... Als Simulation quasi...
Es geht sich ja wirklich erstmal nur um das Makro, der Rest ist alles noch unausgereift und kann erst weiter bearbeitet werden, wenn ich die ISO-Normen habe. Das ist hier Projekt was halt noch seine Zeit braucht. Deswegen muss ich erstmal vorrangig die Funktion ans laufen bringen.
Top
#16
Noch eine Auffälligkeit:

Warum schmiert mir Excel hierbei immer komplett ab? (Code in Tabelle 9 unter Worksheet_Change mit reingepackt)
Code:
If Not Range("$B$15") = "" Then
   Range("C15") = Range("B15")
   Range("C16") = Range("B16")
End If

[
Bild bitte so als Datei hochladen: Klick mich!
]


Bei folgendem aber nicht (Ich habe einfach mal spaßeshalber was eingefärbt. Es sollte doch egal sein ob ich Werte kopiere oder oderr was anderes mache....)


PHP-Code:
'Selektieren und einfärben bzw. entfärben
If Not Range("$B$15") = "" Then
    Range("H7").Select
    With Selection.Interior
    .Color = 65535
    End With
        Else
        Range("H7").Select
        With Selection.Interior
        .Pattern = xlNone
        End With
End If 



Gruß Andi
Top
#17
Hallo ANdi,
wahrscheinlich ist Deine Mappe inzwischen "verkorkst" Sad
Füge mal alles in eine neue ein, schließe die alte und teste es dann in der neuen.
So was geht übrigens auch nicht:
If Not Tabelle1.Range("B15:B16").Value = "" Then
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Top
#18
(06.12.2015, 06:31)schauan schrieb: Hallo ANdi,
wahrscheinlich ist Deine Mappe inzwischen "verkorkst" Sad
Füge mal alles in eine neue ein, schließe die alte und teste es dann in der neuen.
So was geht übrigens auch nicht:
If Not Tabelle1.Range("B15:B16").Value = "" Then


Also, ich habe jetzt rausgefunden:


Es lag nicht an einer verkorksten Datei!
Solbad ich das Worksheet change und die oben genannten Codes nehme schmiert der ab. Nehme ich selection change ist alles gut... Ist das jetzt nen Bug von Office? Habt Ihr das auch? Ansonsten schau ich mich mal nach einer anderen Version um....


DAS GIBTS DOCH NICHT!!! DAS HAT MICH NUN JETZT FAST EINE WOCHE IN DEN WAHNSINN GETRIEBEN!!! :@ :@ :@

Gruß Andi
Top
#19
Hi Andi,

(05.12.2015, 20:08)Andi_Koer_1234 schrieb: Bei folgendem aber nicht (Ich habe einfach mal spaßeshalber was eingefärbt. Es sollte doch egal sein ob ich Werte kopiere oder oderr was anderes mache....)
Dein funktionierender Code kann deutlich gekürzt werden, du mußt nicht selektieren:

Code:
'Selektieren und einfärben bzw. entfärben
If Not Range("$B$15") = "" Then
   Range("H7").Color = 65535
Else
   Range("H7").Pattern = xlNone
End If
[-] Folgende(r) 1 Nutzer sagt Danke an Rabe für diesen Beitrag:
  • Andi_Koer_1234
Top
#20
Hallo Andy,

... und das If Not Tabelle1.Range("B15:B16").Value = "" Then hast Du auch noch drin?
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste