Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 00:42:03
Listbox mit gefilterten Daten füllen
24.04.2024 20:38:58
Summe mit Bedingung, nur letzte Ergebnisse anzeigen
24.04.2024 19:29:30
Formel filter
24.04.2024 18:49:56
merge & select
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
716to720
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
716to720
716to720
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Schleife erstellen...

Schleife erstellen...
08.01.2006 01:09:20
Anja
Hallo Leute,
ich hab ein Problem: ich möchte aus diesem Code gern eine Schleife machen,
in der sich die zeile aus der kopiert werden soll jeweils um 1 erhöht, also z.B. aus "F13:AJ13" wird "F14:AJ14" usw. das ganz soll bis Zeile 87 gehen. Der Code ist deshalb so lang, weil aus jedem Sheet aus dem kopiert wird, der range unterschiedlich ist. wäre supi wenn ihr mir helfen könntet.
Der Hintergrund ist, das dieser Code für 87 Personen gemacht werden soll und ich nehme an in dieser einfachen Form wird Excel sehr langsam werden...oder fällt euch was noch besseres ein, bin für jede idee dankbar.
Ich hoffe ich hab es einigermaßen verständlich geschrieben ;-)?
gruß Anja
If UserForm3.ComboBox2 = "Mustermann, Max" Then
Sheets(2).Select
Range("F13:AJ13").Select
Selection.Copy
Sheets(16).Select
Range("B6").Select
ActiveSheet.Paste
Sheets(3).Select
Range("F13:AG13").Select
Selection.Copy
Sheets(16).Select
Range("B10").Select
ActiveSheet.Paste
Sheets(4).Select
Range("F13:AJ13").Select
Selection.Copy
Sheets(16).Select
Range("B14").Select
ActiveSheet.Paste
Sheets(5).Select
Range("F13:AI13").Select
Selection.Copy
Sheets(16).Select
Range("B18").Select
ActiveSheet.Paste
Sheets(6).Select
Range("F13:AJ13").Select
Selection.Copy
Sheets(16).Select
Range("B22").Select
ActiveSheet.Paste
Sheets(7).Select
Range("F13:AI13").Select
Selection.Copy
Sheets(16).Select
Range("B26").Select
ActiveSheet.Paste
Sheets(8).Select
Range("F13:AJ13").Select
Selection.Copy
Sheets(16).Select
Range("B30").Select
ActiveSheet.Paste
Sheets(9).Select
Range("F13:AJ13").Select
Selection.Copy
Sheets(16).Select
Range("B34").Select
ActiveSheet.Paste
Sheets(10).Select
Range("F13:AI13").Select
Selection.Copy
Sheets(16).Select
Range("B38").Select
ActiveSheet.Paste
Sheets(11).Select
Range("F13:AJ13").Select
Selection.Copy
Sheets(16).Select
Range("B42").Select
ActiveSheet.Paste
Sheets(12).Select
Range("F13:AI13").Select
Selection.Copy
Sheets(16).Select
Range("B46").Select
ActiveSheet.Paste
Sheets(13).Select
Range("F13:AL13").Select
Selection.Copy
Sheets(16).Select
Range("B50").Select
ActiveSheet.Paste
End If

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Schleife erstellen...
08.01.2006 02:07:46
Josef
Hallo Anja!
Ich würde mir mal Gedanken über deinen Tabellenaufbau machen ;-))
Mehr ist, so glaube ich, nicht drin!
Sub zzz()
Dim lngRow As Long
Dim intC As Integer

If UserForm3.ComboBox2 = "Mustermann, Max" Then
  lngRow = 13
  With Sheets(16)
    For intC = 2 To 13
      Select Case intC
        Case 3
          Sheets(intC).Range(Sheets(intC).Cells(lngRow, 6), _
            Sheets(intC).Cells(lngRow, 33)).Copy .Cells(intC * 2 + (2 * (intC - 1)), 2)
        Case 5, 7, 10, 12
          Sheets(intC).Range(Sheets(intC).Cells(lngRow, 6), _
            Sheets(intC).Cells(lngRow, 35)).Copy .Cells(intC * 2 + (2 * (intC - 1)), 2)
        Case 13
          Sheets(intC).Range(Sheets(intC).Cells(lngRow, 6), _
            Sheets(intC).Cells(lngRow, 38)).Copy .Cells(intC * 2 + (2 * (intC - 1)), 2)
        Case Else
          Sheets(intC).Range(Sheets(intC).Cells(lngRow, 6), _
            Sheets(intC).Cells(lngRow, 36)).Copy .Cells(intC * 2 + (2 * (intC - 1)), 2)
      End Select
    Next
  End With
End If

End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Schleife erstellen...
08.01.2006 15:42:59
Anja
Hi,
ich danke dir erstmal, es klappt supi.
hab nur noch ein problem: beim einfügen will ich bestimmente linien um das eingefügte machen, weiß aber nicht genau an welcher stelle des codes ich das einfügen soll, denn mit der case-funktion kenn ich mich nicht weiter aus.
In den einzelnen sheets sind verschiedene Linien um die zellen und beim einfügen in sheet 16 sollen sie ja alle ne einheitliche linie haben. hab dafür auch ein code (siehe unten)
Ich weiß das der Tabellenaufbau nicht der beste zum Prog. ist aber der muß so sein.
gruß Anja

Sub Rahmen()
Dim n As Byte
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
For n = 7 To 10
With Selection.Borders(n)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Next n
End Sub

Anzeige
AW: Schleife erstellen...
08.01.2006 15:52:07
Josef
Hallo Anja!
Probier mal so!
Function Rahmen(Bereich As Range)
Dim n As Byte

With Bereich
  .Borders(xlDiagonalDown).LineStyle = xlNone
  .Borders(xlDiagonalUp).LineStyle = xlNone
  For n = 7 To 10
    With .Borders(n)
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
    End With
  Next
End With

End Function


Sub zzz()
Dim lngRow As Long
Dim intC As Integer

If UserForm3.ComboBox2 = "Mustermann, Max" Then
  lngRow = 13
  With Sheets(16)
    For intC = 2 To 13
      Select Case intC
        Case 3
          Sheets(intC).Range(Sheets(intC).Cells(lngRow, 6), _
            Sheets(intC).Cells(lngRow, 33)).Copy .Cells(intC * 2 + (2 * (intC - 1)), 2)
        Case 5, 7, 10, 12
          Sheets(intC).Range(Sheets(intC).Cells(lngRow, 6), _
            Sheets(intC).Cells(lngRow, 35)).Copy .Cells(intC * 2 + (2 * (intC - 1)), 2)
        Case 13
          Sheets(intC).Range(Sheets(intC).Cells(lngRow, 6), _
            Sheets(intC).Cells(lngRow, 38)).Copy .Cells(intC * 2 + (2 * (intC - 1)), 2)
        Case Else
          Sheets(intC).Range(Sheets(intC).Cells(lngRow, 6), _
            Sheets(intC).Cells(lngRow, 36)).Copy .Cells(intC * 2 + (2 * (intC - 1)), 2)
      End Select
      Rahmen .Cells(intC * 2 + (2 * (intC - 1)), 2)
    Next
  End With
End If

End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Schleife erstellen...
08.01.2006 16:15:09
Anja
Hallo Sepp,
funzt leider nicht, der rahmen wird leider so eingefügt wie er kopiert wird. im prinzip muß der rahmen eingefügt werden wenn die zellen aktiviert sind.
hast du viell. noch ne idee?
Gruß Anja
AW: Schleife erstellen...
08.01.2006 16:39:54
Josef
Hallo Anja!
Wie soll der Rahmen, und um welche Zellen, den aussehen?
'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Schleife erstellen...
08.01.2006 17:07:37
Anja
ich kopier doch von sheet 2-13 jeweils einen bereich (was jeweils Jan.-Dez von einer person ist) in sheet 16. und um den eingefügten bereich (bsp. F13:AJ13) soll ringsum jede einzelne zelle ein dünner rahmen.
gruß anja
AW: Schleife erstellen...
08.01.2006 18:23:43
Josef
Hallo Anja!
So sollte es laufen!
Function Rahmen(Bereich As Range)
Dim n As Byte

With Bereich
  For n = 1 To 12
    With .Borders(n)
      Select Case n
        Case 7 To 11
          .LineStyle = xlContinuous
          .Weight = xlThin
          .ColorIndex = xlAutomatic
        Case Else
          .LineStyle = xlNone
      End Select
    End With
  Next
End With

End Function



Sub zzz()
Dim lngRow As Long
Dim intC As Integer

If UserForm3.ComboBox2 = "Mustermann, Max" Then
  lngRow = 13
  With Sheets(16)
    For intC = 2 To 13
      Select Case intC
        Case 3
          Sheets(intC).Range(Sheets(intC).Cells(lngRow, 6), _
            Sheets(intC).Cells(lngRow, 33)).Copy .Range(.Cells(intC * 2 + (2 * (intC - 1)), 2), _
            .Cells(intC * 2 + (2 * (intC - 1)), 29))
          Rahmen .Range(.Cells(intC * 2 + (2 * (intC - 1)), 2), _
            .Cells(intC * 2 + (2 * (intC - 1)), 29))
        Case 5, 7, 10, 12
          Sheets(intC).Range(Sheets(intC).Cells(lngRow, 6), _
            Sheets(intC).Cells(lngRow, 35)).Copy .Range(.Cells(intC * 2 + (2 * (intC - 1)), 2), _
            .Cells(intC * 2 + (2 * (intC - 1)), 31))
          Rahmen .Range(.Cells(intC * 2 + (2 * (intC - 1)), 2), _
            .Cells(intC * 2 + (2 * (intC - 1)), 31))
        Case 13
          Sheets(intC).Range(Sheets(intC).Cells(lngRow, 6), _
            Sheets(intC).Cells(lngRow, 38)).Copy .Range(.Cells(intC * 2 + (2 * (intC - 1)), 2), _
            .Cells(intC * 2 + (2 * (intC - 1)), 34))
          Rahmen .Range(.Cells(intC * 2 + (2 * (intC - 1)), 2), _
            .Cells(intC * 2 + (2 * (intC - 1)), 34))
        Case Else
          Sheets(intC).Range(Sheets(intC).Cells(lngRow, 6), _
            Sheets(intC).Cells(lngRow, 36)).Copy .Range(.Cells(intC * 2 + (2 * (intC - 1)), 2), _
            .Cells(intC * 2 + (2 * (intC - 1)), 32))
          Rahmen .Range(.Cells(intC * 2 + (2 * (intC - 1)), 2), _
            .Cells(intC * 2 + (2 * (intC - 1)), 32))
      End Select
    Next
  End With
End If

End Sub



'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Schleife erstellen...
09.01.2006 16:12:48
Anja
Super klappt perfekt. jetzt ist nur noch eine klitzkleine sache, dachte ich bekomm sie selbst hin aber dem ist doch nicht so:
möchte jetzt noch oben auf die Seite den jeweiligen Namen den ich im Userform auswähle haben. also etwa so:
If UserForm3.ComboBox2 = "Mustermann, Max" Then
Range("B1").Select
ActiveCell.FormulaR1C1 = UserForm3.ComboBox1 (jewilige Schicht)
Range("B2").Select
ActiveCell.FormulaR1C1 = UserForm3.ComboBox2 (jeweiliger Name)
Range("A1").Select
und dann den rest der schleife... aber funktioniert irgendwie nicht. Der Name/Schicht kommt immer auf Sheet(1)
gruß Anja
Anzeige
AW: Schleife erstellen...
09.01.2006 19:54:55
Josef
Hallo Anja!
If UserForm3.ComboBox2 = "Mustermann, Max" Then
  lngRow = 13
  With Sheets(16)
    
    .Range("A1") = UserForm3.ComboBox2.Text
    .Range("B2") = UserForm3.ComboBox1.Text
    
    For intC = 2 To 13
      Select Case intC
        Case 3
          Sheets(intC).Range(Sheets(intC).Cells(lngRow, 6), _
            Sheets(intC).Cells(lngRow, 33)).Copy .Range(.Cells(intC * 2 + (2 * (intC - 1)), 2), _
            .Cells(intC * 2 + (2 * (intC - 1)), 29))
          Rahmen .Range(.Cells(intC * 2 + (2 * (intC - 1)), 2), _
            .Cells(intC * 2 + (2 * (intC - 1)), 29))
        Case 5, 7, 10, 12
          Sheets(intC).Range(Sheets(intC).Cells(lngRow, 6), _
            Sheets(intC).Cells(lngRow, 35)).Copy .Range(.Cells(intC * 2 + (2 * (intC - 1)), 2), _
            .Cells(intC * 2 + (2 * (intC - 1)), 31))
          Rahmen .Range(.Cells(intC * 2 + (2 * (intC - 1)), 2), _
            .Cells(intC * 2 + (2 * (intC - 1)), 31))
        Case 13
          Sheets(intC).Range(Sheets(intC).Cells(lngRow, 6), _
            Sheets(intC).Cells(lngRow, 38)).Copy .Range(.Cells(intC * 2 + (2 * (intC - 1)), 2), _
            .Cells(intC * 2 + (2 * (intC - 1)), 34))
          Rahmen .Range(.Cells(intC * 2 + (2 * (intC - 1)), 2), _
            .Cells(intC * 2 + (2 * (intC - 1)), 34))
        Case Else
          Sheets(intC).Range(Sheets(intC).Cells(lngRow, 6), _
            Sheets(intC).Cells(lngRow, 36)).Copy .Range(.Cells(intC * 2 + (2 * (intC - 1)), 2), _
            .Cells(intC * 2 + (2 * (intC - 1)), 32))
          Rahmen .Range(.Cells(intC * 2 + (2 * (intC - 1)), 2), _
            .Cells(intC * 2 + (2 * (intC - 1)), 32))
      End Select
    Next
  End With
End If

'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Schleife erstellen...
11.01.2006 00:31:24
Anja
danke jetzt funktioniert alles so super und nun wird die Prozedur zu groß, muß ja den Code ca. 45mal wiederholen. mist...
AW: Schleife erstellen...
11.01.2006 00:35:53
Josef
Hallo Anja!
Zeig doch mal die Datei!
Glaub nicht das es so kompliziert sein muss.
'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige

Links zu Excel-Dialogen

ComboBox UserForm

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige