Wenn du mir ein Tip geben könntest wie es ausehen könnte,
Einfach&geschmacklos-quick&dirty
1 x einrichten:
Private Sub NameIt()
'
'******************************************************************************
' Name : NameIt / erstellt : 18.11.2014 / 15:07 / Sub
'------------------------------------------------------------------------------
'
' initialisiere Blöcke nach Definition
'
'******************************************************************************
'
Const A_BLOCK1 As String = "$A$2:$AI$38"
Const B_BLOCK1 As String = "$AK$2:$BS$38"
Dim c As Range, n As Name, x As Long, z As Long, sN As String
Dim oWb As Workbook
Set oWb = ThisWorkbook
oWb.Sheets("Export").Activate
For Each n In Names
n.Delete
Next n
Set c = Range(A_BLOCK1)
z = c.Rows.Count
For x = 1 To 15
sN = "Block" & Format(x, "00") & "a" '<< wahlfrei benamsen
oWb.Names.Add Name:=sN, RefersTo:=c
Set c = c.Offset(z)
Next x
Set c = Range(B_BLOCK1)
z = c.Rows.Count
For x = 1 To 15
sN = "Block" & Format(x, "00") & "b" '<< wahlfrei benamsen
oWb.Names.Add Name:=sN, RefersTo:=c
Set c = c.Offset(z)
Next x
Set oWb = Nothing
End Sub
Userform hab ich zus. mit SpinButton1 aufgehübscht - vertauscht Quelle / Ziel - Listen
Option Explicit
Dim oWbk As Workbook
Dim oWsh As Worksheet
Dim aBlock(), bBlock() 'Arrays für Listenfelder
Private Sub CMD_Copy_Click()
Dim sc As Range, st As Range 'source / target
If ListBoxB.ListIndex < 0 Or ListBoxB.ListIndex < 0 Then
Call MsgBox("keine gültige Auswahl!", vbCritical, "Abbruch")
Exit Sub
End If
With oWsh
Set sc = .Range(ListBoxB.Column(0))
Set st = .Range(ListBoxA.Column(0))
Select Case MsgBox("von " & sc.Address & " - nach " & st.Address, _
vbOKCancel Or vbInformation Or vbDefaultButton1, "CMD_Copy")
Case vbOK
sc.Copy
st.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
sc.Cells(1).Select
RefreshLists
Case vbCancel
'
End Select
End With
End Sub
Private Sub SpinButton1_Change()
'
'******************************************************************************
' Name : SpinButton1_Change / erstellt : 18.11.2014 / 15:21 / Sub
'------------------------------------------------------------------------------
'
' vertausche Anzeigen in Listen (Quelle - Ziel)
'
'******************************************************************************
'
Select Case SpinButton1.Value
Case 0
With ListBoxA 'Target
.Clear
.List = aBlock
End With
With ListBoxB 'Source
.Clear
.List = bBlock
End With
Case 1
With ListBoxA 'Target
.Clear
.List = bBlock
End With
With ListBoxB 'Source
.Clear
.List = aBlock
End With
End Select
End Sub
Private Sub UserForm_Deactivate()
Set oWbk = Nothing
Set oWsh = Nothing
End Sub
Private Sub UserForm_Initialize()
Set oWbk = ThisWorkbook
Set oWsh = oWbk.Sheets("Export")
RefreshLists 'Neuaufbau der Listenfelder
End Sub
Private Sub RefreshLists()
'
'******************************************************************************
' Name : RefreshLists / erstellt : 18.11.2014 / 15:15 / Sub
'------------------------------------------------------------------------------
'
' Listenfelder haben 4 Spalten, Spalte 0 wird verborgen
'
'******************************************************************************
'
Dim n As Name, acnt As Long, bcnt As Long
Dim c As Range
oWsh.Activate
For Each n In oWbk.Names
If Left(n.Name, 5) = "Block" Then '<< wie in Sub NameIt()benannt !
Select Case Right(n.Name, 1) 'ditto
Case "a"
acnt = acnt + 1
Case "b"
bcnt = bcnt + 1
End Select
End If
Next n
ReDim aBlock(1 To acnt, 0 To 3)
ReDim bBlock(1 To acnt, 0 To 3)
acnt = 0: bcnt = 0
For Each n In oWbk.Names
If Left(n.Name, 5) = "Block" Then '<< wie in Sub NameIt()benannt !
Select Case Right(n.Name, 1) 'ditto
Case "a"
acnt = acnt + 1
Set c = n.RefersToRange '<< Ziel
aBlock(acnt, 0) = c.Address 'Adresse zu
aBlock(acnt, 1) = n.Name 'Ausgabe in Spalte
Set c = Range(aBlock(acnt, 0))
aBlock(acnt, 2) = c.Cells(4).Value 'sichtbarer Wert in Spalte
aBlock(acnt, 3) = c.Cells(5).Value 'ditto
Case "b"
bcnt = bcnt + 1
Set c = n.RefersToRange
bBlock(bcnt, 0) = c.Address '<< Quelle
bBlock(bcnt, 1) = n.Name 'ditto
Set c = Range(bBlock(bcnt, 0))
bBlock(bcnt, 2) = c.Cells(4).Value
bBlock(bcnt, 3) = c.Cells(5).Value
End Select
End If
Next n
With ListBoxA 'Bereich A - Ziel versorgen
.ColumnCount = 4
.ColumnWidths = "0; 60 ; 60; 60"
.Clear
.List = aBlock
End With
With ListBoxB 'Bereich B - Quelle versorgen
.ColumnCount = 4
.ColumnWidths = "0; 60 ; 60; 60"
.Clear
.List = bBlock
End With
End Sub
|