AW: Code von CommanButton in Schaltfläche
05.01.2006 13:44:40
CommanButton
Hallo,
ich habe die Datei nochmals hochgeladen (https://www.herber.de/bbs/user/29747.xls
) und auch gefunden.
Ansonsten hier der Code:
Option Explicit
Private Sub Label13_Click()
End Sub
Private Sub Label3_Click()
End Sub
Private Sub CommandButton1_Click()
Range("B10").Select
Unload Me
Doppelte_Farbe.Hide
End Sub
Private Sub UserForm_Initialize()
Dim AM As Object
Dim r As Integer, s As Integer, t As Integer
For Each AM In Application.Workbooks
With ComboBox1
.AddItem AM.Name
End With
Next AM
End Sub
Private Sub ComboBox1_Change()
Dim Blatt As Object
Workbooks(ComboBox1.Text).Activate
For Each Blatt In ActiveWorkbook.Sheets
With ComboBox9
.AddItem Blatt.Name
End With
Next Blatt
End Sub
'
Private Sub ComboBox9_Change()
Private Sub ComboBox9_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Worksheets(ComboBox9.Text).Activate
End Sub
Private Sub CommandButton2_Click()
Dim iRowA As Integer, iRowB As Integer
Dim iCol As Integer, iColor As Integer
Dim iRowC As Integer
Dim bln As Boolean, blnColor As Boolean
Dim myName1 As String, myDatei As String
Dim myName2 As String, Tb(1 To 15) As Worksheet, gefunden As Boolean
Const ic1 As Integer = 35
myDatei = ComboBox1.Text
myName1 = ComboBox9.Text 'InputBox("Ausgangstabelle auswählen:")
For Each Tb(3) In ThisWorkbook.Worksheets
If Tb(3).Name = "Doppelte" Then gefunden = True: Exit For
Next
If Not gefunden Then
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Doppelte"
End If
Set Tb(3) = ThisWorkbook.Worksheets("Doppelte")
With Tb(3)
.Cells.Clear
.Cells(1, 1) = "Doppelte Daten aus Tabelle " & myName1
End With
Sheets(myName1).Activate
iRowA = 2
' iColor = 2
iColor = 3
Do Until IsEmpty(Cells(iRowA, 1))
iRowB = iRowA + 1
Do Until IsEmpty(Cells(iRowB, 1))
For iCol = 1 To 50
If Cells(iRowA, iCol) <> Cells(iRowB, iCol) Then
bln = True
Exit For
End If
Next iCol
If bln = False Then
' If blnColor = False Then
' iColor = iColor + 1
' End If
If Cells(iRowB, 1).Interior.ColorIndex = _
xlColorIndexNone Then
If Cells(iRowA, 1).Interior.ColorIndex = _
xlColorIndexNone Then
With Worksheets("Doppelte")
iRowC = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Range(.Cells(iRowC, 1), .Cells(iRowC, 50)).Value = _
Range(Cells(iRowB, 1), Cells(iRowB, 50)).Value
End With
End If
Range(Cells(iRowA, 1), Cells(iRowA, 50)). _
Interior.ColorIndex = ic1
Range(Cells(iRowB, 1), Cells(iRowB, 50)). _
Interior.ColorIndex = iColor
blnColor = True
End If
End If
iRowB = iRowB + 1
bln = False
Loop
blnColor = False
iRowA = iRowA + 1
Loop
Sheets("Doppelte").Activate
Range("G1").Select
Unload Me
Doppelte_Farbe.Hide
Sheets(myName1).Activate
End Sub