Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema Label
BildScreenshot zu Label Label-Seite mit Beispielarbeitsmappe aufrufen

Bitte mal drüber schauen

Betrifft: Bitte mal drüber schauen von: Laeubchen
Geschrieben am: 10.08.2014 19:40:54

Hallo,

es ist schon lang her, das ich mich mit Excel sowie VBA beschäftigt habe.

Nun habe ich ein wenig was zusammgebastelt.

Es wäre nett könnte Jemand so nett sein und mal rüber schauen, da ich mir nicht sicher bin, ob es Probleme geben kann und ob die Möglichkeit besteht, diesen Code etwas kürzer zu fassen.

Es handelt sich hierbei um Tabellenblätter (RT 1 und RT 2) die Daten enthalten, die später für den Ausdruck von Etiketten (Eti 1 und Eti 2) verwendet werden müssen.

So weit funktioniert die Datenübernahme.

Mein Problem ist ebenso, wenn eine Zeile mal freigelassen wird, so ist ein Etikett umsonst bzw mit den Grunddaten dazwischen. Das Problem besteht aber nur wenn keine Schweißnahtnummer mit der dazugehörigen Nennweite eingegeben wird. Das kann passieren, damit man den Überblick nicht verliert.

Ich hoffe ich konnte mich ein wenig verständlich ausdrücken und wäre für jeden guten Rat und Tipp dankbar.

Option Explicit
'Hiermit wird verlangt, dass alle benutzten Variablen definiert werden.





Sub ExportDaten()
'
'
' erstellt von Laeubchen



    Application.ScreenUpdating = False
   'Deaktiviert die Bildschirmaktualisierung während der Makro-Ausführung.
   'Das Makro wird schneller ausgeführt und der Bildschirm flackert nicht.

    
    ''''''''''''''''''''''''''''''''''''''''''''''''''
    
    ' Schweißnahtnummer RT 1 Eti 1 FERTIG
    
    Dim RngCopy As Range, RngPaste As Range
    Dim aWerte()
    
    Set RngCopy = Sheets("RT 1").Range("B28:F28")
    Set RngPaste = Sheets("Eti 1").Range("B4:D4")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
    
    Set RngCopy = Sheets("RT 1").Range("B29:F29")
    Set RngPaste = Sheets("Eti 1").Range("I4:K4")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
     
    Set RngCopy = Sheets("RT 1").Range("B30:F30")
    Set RngPaste = Sheets("Eti 1").Range("B12:D12")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
    
    Set RngCopy = Sheets("RT 1").Range("B31:F31")
    Set RngPaste = Sheets("Eti 1").Range("I12:K12")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
        
    Set RngCopy = Sheets("RT 1").Range("B32:F32")
    Set RngPaste = Sheets("Eti 1").Range("B20:D20")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
    
    Set RngCopy = Sheets("RT 1").Range("B33:F33")
    Set RngPaste = Sheets("Eti 1").Range("I20:K20")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
    
    Set RngCopy = Sheets("RT 1").Range("B34:F34")
    Set RngPaste = Sheets("Eti 1").Range("B28:D28")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
    
    Set RngCopy = Sheets("RT 1").Range("B35:F35")
    Set RngPaste = Sheets("Eti 1").Range("I28:K28")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''
    
    ' Schweißnahtnummer RT 2 Eti 1 FERTIG
    
    Set RngCopy = Sheets("RT 2").Range("B18:F18")
    Set RngPaste = Sheets("Eti 1").Range("B36:F36")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
    
    Set RngCopy = Sheets("RT 2").Range("B19:F19")
    Set RngPaste = Sheets("Eti 1").Range("I36:K36")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
     
    Set RngCopy = Sheets("RT 2").Range("B20:F20")
    Set RngPaste = Sheets("Eti 1").Range("B44:B44")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
    
    Set RngCopy = Sheets("RT 2").Range("B21:F21")
    Set RngPaste = Sheets("Eti 1").Range("I44:K44")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''
    
    ' Schweißnahtnummer RT 2 Eti 2 FERTIG
    
    Set RngCopy = Sheets("RT 2").Range("B22:F22")
    Set RngPaste = Sheets("Eti 2").Range("B4:D4")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
    
    Set RngCopy = Sheets("RT 2").Range("B23:F23")
    Set RngPaste = Sheets("Eti 2").Range("I4:K4")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
     
    Set RngCopy = Sheets("RT 2").Range("B24:F24")
    Set RngPaste = Sheets("Eti 2").Range("B12:D12")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
    
    Set RngCopy = Sheets("RT 2").Range("B25:F25")
    Set RngPaste = Sheets("Eti 2").Range("I12:K12")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
        
    Set RngCopy = Sheets("RT 2").Range("B26:F26")
    Set RngPaste = Sheets("Eti 2").Range("B20:D20")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
    
    Set RngCopy = Sheets("RT 2").Range("B27:F27")
    Set RngPaste = Sheets("Eti 2").Range("I20:K20")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
    
    Set RngCopy = Sheets("RT 2").Range("B28:F28")
    Set RngPaste = Sheets("Eti 2").Range("B28:D28")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
    
    Set RngCopy = Sheets("RT 2").Range("B29:F29")
    Set RngPaste = Sheets("Eti 2").Range("I28:K28")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
    
    Set RngCopy = Sheets("RT 2").Range("B30:F30")
    Set RngPaste = Sheets("Eti 2").Range("B36:D36")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
        
    Set RngCopy = Sheets("RT 2").Range("B31:F31")
    Set RngPaste = Sheets("Eti 2").Range("B36:D36")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
    
    Set RngCopy = Sheets("RT 2").Range("B32:F32")
    Set RngPaste = Sheets("Eti 2").Range("I36:K36")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
    
    Set RngCopy = Sheets("RT 2").Range("B34:F34")
    Set RngPaste = Sheets("Eti 2").Range("B44:D44")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
    
    
    Set RngCopy = Sheets("RT 2").Range("B35:F35")
    Set RngPaste = Sheets("Eti 2").Range("I44:K44")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
    
       
    ''''''''''''''''''''''''''''''''''''''''''''''''''
    
    ' Nennweiten Eti 1 FERTIG
    
    Dim Rng1Copy As Range, Rng1Paste As Range
    Dim bWerte()
    
    
    Set Rng1Copy = Sheets("RT 1").Range("M28:N28")
    Set Rng1Paste = Sheets("Eti 1").Range("F5")
    
    bWerte() = Rng1Copy
    Rng1Paste = bWerte()
    
    Set Rng1Copy = Sheets("RT 1").Range("M29:N29")
    Set Rng1Paste = Sheets("Eti 1").Range("M5")
    
    bWerte() = Rng1Copy
    Rng1Paste = bWerte()
     
    Set Rng1Copy = Sheets("RT 1").Range("M30:N30")
    Set Rng1Paste = Sheets("Eti 1").Range("F13")
    
    bWerte() = Rng1Copy
    Rng1Paste = bWerte()
    
    Set Rng1Copy = Sheets("RT 1").Range("M31:N31")
    Set Rng1Paste = Sheets("Eti 1").Range("M13")
    
    bWerte() = Rng1Copy
    Rng1Paste = bWerte()
        
    Set Rng1Copy = Sheets("RT 1").Range("M32:N32")
    Set Rng1Paste = Sheets("Eti 1").Range("F21")
    
    bWerte() = Rng1Copy
    Rng1Paste = bWerte()
    
    Set Rng1Copy = Sheets("RT 1").Range("M33:N33")
    Set Rng1Paste = Sheets("Eti 1").Range("M21")
    
    bWerte() = Rng1Copy
    Rng1Paste = bWerte()
    
    Set Rng1Copy = Sheets("RT 1").Range("M34:N34")
    Set Rng1Paste = Sheets("Eti 1").Range("F29")
    
    bWerte() = Rng1Copy
    Rng1Paste = bWerte()
    
    Set Rng1Copy = Sheets("RT 1").Range("M35:N35")
    Set Rng1Paste = Sheets("Eti 1").Range("M29")
    
    bWerte() = Rng1Copy
    Rng1Paste = bWerte()
    
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''
    
    ' Nennweiten Eti 1 RT 2
    
    Set Rng1Copy = Sheets("RT 2").Range("M18:N18")
    Set Rng1Paste = Sheets("Eti 1").Range("F37")
    
    bWerte() = Rng1Copy
    Rng1Paste = bWerte()
    
    Set Rng1Copy = Sheets("RT 2").Range("M19:N19")
    Set Rng1Paste = Sheets("Eti 1").Range("M37")
    
    bWerte() = Rng1Copy
    Rng1Paste = bWerte()
    
    Set Rng1Copy = Sheets("RT 2").Range("M20:N20")
    Set Rng1Paste = Sheets("Eti 1").Range("F45")
    
    bWerte() = Rng1Copy
    Rng1Paste = bWerte()
    
    Set Rng1Copy = Sheets("RT 2").Range("M21:N21")
    Set Rng1Paste = Sheets("Eti 1").Range("M45")
    
    bWerte() = Rng1Copy
    Rng1Paste = bWerte()
        
    ''''''''''''''''''''''''''''''''''''''''''''''''''
    
    ' Nennweiten Eti 2 RT 2
    
    
    Set Rng1Copy = Sheets("RT 2").Range("M22:N22")
    Set Rng1Paste = Sheets("Eti 2").Range("F5")
    
    bWerte() = Rng1Copy
    Rng1Paste = bWerte()
    
    Set Rng1Copy = Sheets("RT 2").Range("M23:N23")
    Set Rng1Paste = Sheets("Eti 2").Range("M5")
    
    bWerte() = Rng1Copy
    Rng1Paste = bWerte()
     
    Set Rng1Copy = Sheets("RT 2").Range("M24:N24")
    Set Rng1Paste = Sheets("Eti 2").Range("F13")
    
    bWerte() = Rng1Copy
    Rng1Paste = bWerte()
    
    Set Rng1Copy = Sheets("RT 2").Range("M25:N25")
    Set Rng1Paste = Sheets("Eti 2").Range("M13")
    
    bWerte() = Rng1Copy
    Rng1Paste = bWerte()
        
    Set Rng1Copy = Sheets("RT 2").Range("M26:N26")
    Set Rng1Paste = Sheets("Eti 2").Range("F21")
    
    bWerte() = Rng1Copy
    Rng1Paste = bWerte()
    
    Set Rng1Copy = Sheets("RT 2").Range("M27:N27")
    Set Rng1Paste = Sheets("Eti 2").Range("M21")
    
    bWerte() = Rng1Copy
    Rng1Paste = bWerte()
    
    Set Rng1Copy = Sheets("RT 2").Range("M28:N28")
    Set Rng1Paste = Sheets("Eti 2").Range("F29")
    
    bWerte() = Rng1Copy
    Rng1Paste = bWerte()
    
    Set Rng1Copy = Sheets("RT 2").Range("M29:N29")
    Set Rng1Paste = Sheets("Eti 2").Range("M29")
    
    bWerte() = Rng1Copy
    Rng1Paste = bWerte()
    
    Set Rng1Copy = Sheets("RT 2").Range("M30:N30")
    Set Rng1Paste = Sheets("Eti 2").Range("F37")
    
    bWerte() = Rng1Copy
    Rng1Paste = bWerte()
    
    Set Rng1Copy = Sheets("RT 2").Range("M31:N31")
    Set Rng1Paste = Sheets("Eti 2").Range("M37")
    
    bWerte() = Rng1Copy
    Rng1Paste = bWerte()
    
    Set Rng1Copy = Sheets("RT 2").Range("M32:N32")
    Set Rng1Paste = Sheets("Eti 2").Range("F45")
    
    bWerte() = Rng1Copy
    Rng1Paste = bWerte()
    
    Set Rng1Copy = Sheets("RT 2").Range("M33:N33")
    Set Rng1Paste = Sheets("Eti 2").Range("M45")
    
    bWerte() = Rng1Copy
    Rng1Paste = bWerte()
    
       
    Set Rng1Copy = Sheets("RT 2").Range("M34:N34")
    Set Rng1Paste = Sheets("Eti 2").Range("F44")
    
    bWerte() = Rng1Copy
    Rng1Paste = bWerte()
    
    Set Rng1Copy = Sheets("RT 2").Range("M35:N35")
    Set Rng1Paste = Sheets("Eti 2").Range("M44")
    
    bWerte() = Rng1Copy
    Rng1Paste = bWerte()
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''
    
    'Nennweiten Format
    Sheets("Eti 1").Range("F5, M5, F13, M13, F21, M21, F29, M29, F37, M37, F45, M45"). _
NumberFormat = """t = ""@ ""mm"""
    Sheets("Eti 2").Range("F5, M5, F13, M13, F21, M21, F29, M29, F37, M37, F45, M45"). _
NumberFormat = """t = ""@ ""mm"""

    ''''''''''''''''''''''''''''''''''''''''''''''''''
    
    'Grunddaten
    
    'Projekt Eti 1
    Set RngCopy = Sheets("RT 1").Range("AE6:AX6")
    Set RngPaste = Sheets("Eti 1").Range("B2:D2, I2:K2, B10:D10, I10:K10,  B18:D18, I18:K18,     _
 _
 _
 _
 _
 _
_
_
B26:D26, I26:K26, B34:D34, I34:I34, B42:D42, I42:I42")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
    
    'Projekt Eti 2
    Set RngCopy = Sheets("RT 1").Range("AE6:AX6")
    Set RngPaste = Sheets("Eti 2").Range("B2:D2, I2:K2, B10:D10, I10:K10,  B18:D18, I18:K18,     _
 _
 _
 _
 _
 _
_
_
B26:D26, I26:K26, B34:D34, I34:I34, B42:D42, I42:I42")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
  
    'Prüfobjekt Eti 1
    Set RngCopy = Sheets("RT 1").Range("AY6:BL6")
    Set RngPaste = Sheets("Eti 1").Range("B3:D3, I3:K3, B11:D11, I11:K11,  B19:D19, I19:K19,     _
 _
 _
 _
 _
 _
_
_
B27:D27, I27:K27, B35:D35, I35:I35, B43:D43, I43:I43")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
    
    'Prüfobjekt Eti 2
    Set RngCopy = Sheets("RT 1").Range("AY6:BL6")
    Set RngPaste = Sheets("Eti 2").Range("B3:D3, I3:K3, B11:D11, I11:K11,  B19:D19, I19:K19,     _
 _
 _
 _
 _
 _
_
_
B27:D27, I27:K27, B35:D35, I35:I35, B43:D43, I43:I43")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
  
    'Schmitt-Nr. Eti 1
    Set RngCopy = Sheets("RT 1").Range("BH4:BI4")
    Set RngPaste = Sheets("Eti 1").Range("F1, M1, F9, M9, F17, M17, F25, M25, F33, M33, F41,  _
M41")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
    
    'Schmitt-Nr. Eti 2
    Set RngCopy = Sheets("RT 1").Range("BH4:BI4")
    Set RngPaste = Sheets("Eti 2").Range("F1, M1, F9, M9, F17, M17, F25, M25, F33, M33, F41,  _
M41")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
  
    'Auftrags-Nr. Eti 1
    Set RngCopy = Sheets("RT 1").Range("M6:AD6")
    Set RngPaste = Sheets("Eti 1").Range("F2, M2, F10, M10, F18, M18, F26, M26, F34, M34, F42,   _
 _
 _
 _
 _
 _
 _
_
M42")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
    
    'Auftrags-Nr. Eti 2
    Set RngCopy = Sheets("RT 1").Range("M6:AD6")
    Set RngPaste = Sheets("Eti 2").Range("F2, M2, F10, M10, F18, M18, F26, M26, F34, M34, F42,   _
 _
 _
 _
 _
 _
 _
_
M42")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
  
    'Berichts-Nr. Eti 1
    Set RngCopy = Sheets("RT 1").Range("BK4:BL4")
    Set RngPaste = Sheets("Eti 1").Range("F4, M4, F12, M12, F20, M20, F28, M28, F36, M36, F44,   _
 _
 _
 _
 _
 _
 _
_
M44")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
    
    'Berichts-Nr. Eti 2
    Set RngCopy = Sheets("RT 1").Range("BK4:BL4")
    Set RngPaste = Sheets("Eti 2").Range("F4, M4, F12, M12, F20, M20, F28, M28, F36, M36, F44,   _
 _
 _
 _
 _
 _
 _
_
M44")
    
    aWerte() = RngCopy
    RngPaste = aWerte()
  
    'Datum Eti 1 mit Formatierung des Datums
    Set RngCopy = Sheets("RT 1").Range("AP10:AX10")
    Set RngPaste = Sheets("Eti 1").Range("D5, K5, D13, K13, D21, K21, D29, K29, D37, K37, D45,   _
 _
 _
 _
 _
 _
 _
_
K45")
    Range("D5, K5, D13, K13, D21, K21, D29, K29, D37, K37, D45, K45").NumberFormat = "dd/mm/ _
yyyy;@"

    
    aWerte() = RngCopy
    RngPaste = aWerte()
    
    'Datum Eti 2 mit Formatierung des Datums
    Set RngCopy = Sheets("RT 1").Range("AP10:AX10")
    Set RngPaste = Sheets("Eti 2").Range("D5, K5, D13, K13, D21, K21, D29, K29, D37, K37, D45,   _
 _
 _
 _
 _
 _
 _
_
K45")
    Range("D5, K5, D13, K13, D21, K21, D29, K29, D37, K37, D45, K45").NumberFormat = "dd/mm/ _
yyyy;@"
    
    aWerte() = RngCopy
    RngPaste = aWerte()
  
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''
  
    Application.CutCopyMode = False:  Application.ScreenUpdating = True
   'Die Kopiermarkierung aufheben und die Bildschirmaktualisierung wieder aktivieren
    

End Sub

  

Betrifft: Tip: Schleife von: MCO
Geschrieben am: 11.08.2014 07:25:34

Guten Morgen!

Es ist wahrscheinlich nicht schneller aber wesentlich übersichtlicher, wenn du für das Beschreiben des Label-Sheets eine Schleife benutzt.
Für jedes Blatt würde ich an deiner Stelle eine neue Schleife bauen, es sei denn, du willst schon mit arrays arbeiten :-)

Die Schleife geht die Variablen 0 bis 5 durch. Die Variable X gibt den Versatz zur originalen zeile an. Damit gehe ich beim kopieren JEDE Zeile durch (eine Bedingung zum überspringen leerer Zeilen fehlt noch) beim Einfügen wird die Einfügezeile mit jedem Durchlauf einer geraden Zahl (x = 0, 2, 4, 6 usw) um x + 8 weitere Zeilen versetzt, ungerade um x + 7 (weil "x" 1 Zähler höher ist).

Anschließend werden die Werte wie gewohnt eingefügt.
Probiers mal aus, dann wird's deutlicher. (Einzelschritt mit F8)

Poste mal, wenn du's soweit hast. Vielleicht läßt sich dieses Prinzip ja auch auf den Rest vom Code ableiten...

Gruß, MCO

    Dim RngCopy As Range, RngPaste As Range
    Dim aWerte()
    
    
    For x = 0 To 5
        Set RngCopy = Sheets("RT 1").Range("B28:F28").Offset(x, 0)
        
        With Sheets("Eti 1")
            If WorksheetFunction.Even(x) = x Then 'prüft ob gerade oder ungerade
                Set RngPaste = .Range("B4:D4").Offset(x * 8, 0)
            Else
                Set RngPaste = .Range("I4:K4").Offset((x-1) * 8, 0)
            End If
       End With       
        aWerte() = RngCopy
        RngPaste = aWerte()
    Next x



  

Betrifft: AW: Tip: Schleife von: Laeubchen
Geschrieben am: 12.08.2014 13:11:37

Hallo MCO,

vielen Dank für Dein Feedback.

Ich kann leider nicht immer gleich antworten, da ich arbeitsmäßig immer außerhalb bin.

Folgende Fehlermeldung kommt bei meinem ersten Versuch:

aWerte() = RngCopy

Laufzeitfehler '13' Typen unverträglich.

Es wäre nett, könntest Du mir vielleicht einen Tipp geben.

Gruß
Laeubchen


  

Betrifft: AW: Tip: Schleife von: Gerold
Geschrieben am: 15.08.2014 23:41:54

Hallo Laeubchen

Bei aWerte() wurde kein Typ angelegt (Dim aWerte() as Range)

Ausserdem können keine 5 Werte aus [Sheets("RT 1").Range("B28:F28")]
in drei Zellen [Sheets("Eti 1").Range("B4:D4")]untergebracht werden.


Vieleicht so mit Schleifen, siehe MCO.


Option Explicit

Sub test()
Dim x As Variant
For x = 0 To 5
   Sheets("RT 1").Range("B28:F28").Offset(x, 0).Copy
   Worksheets("Eti 1").Select
   With ActiveSheet
      If WorksheetFunction.Even(x) = x Then 'prüft ob gerade oder ungerade
         .Range("B4").Offset(x * 8, 0).Select
         ActiveSheet.Paste
      Else
         .Range("I4").Offset((x - 1) * 8, 0).Select
         ActiveSheet.Paste
      End If
  End With
Next x
Application.CutCopyMode = False
End Sub

Gruß Gerold