Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
632to636
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
632to636
632to636
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

code erweitern

code erweitern
07.07.2005 10:02:25
mehmet
hallo forum,
dieser code bezieht sich nur auf tabelle1
wie kann man es so codieren,
dass es sich auf allen tabellen in blanko0.xls sich bezieht.
also statt sheet(1) sollte sheet(n) sein
dank und gruss
mehmet
'Tabelle1
Option Explicit

Private Sub ListBox1_Click()
Workbooks("Blanko0.xls").Sheets(1).Range("A" & CStr(ListBox1.List(ListBox1.ListIndex, 1)) & ":G" & CStr(ListBox1.List(ListBox1.ListIndex, 1))).Copy ActiveSheet.Range("A1:G1")
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: code erweitern
07.07.2005 10:11:32
Heinz
Hallo,
z.B. so:

Private Sub ListBox1_Click()
Dim i%, z%
With Workbooks("Blanko0.xls")
For i = 1 To .Worksheets.Count
.Sheets(i).Range("A" & CStr(ListBox1.List(ListBox1.ListIndex, 1)) & ":G" & _
CStr(ListBox1.List(ListBox1.ListIndex, 1))).Copy ActiveSheet.Range("A1").Offset(z, 0)
z = z + 1
Next i
End With
End Sub

Gruß
Heinz
AW: code erweitern
07.07.2005 10:12:37
Matthias
Hallo Mehmet,
eigentlich so:

Private Sub ListBox1_Click()
Dim ws As Worksheet
For Each ws In Workbooks("Blanko0.xls")
ws.Range("A" & CStr(ListBox1.List(ListBox1.ListIndex, 1)) & ":G" & _
CStr(ListBox1.List(ListBox1.ListIndex, 1))).Copy ActiveSheet.Range("A1:G1")
Next ws
End Sub

Aber da wird ja alles in den selben Bereich kopiert... Wohin sollen denn die einzelnen Bereiche hin?
Gruß Matthias
Anzeige
AW: code erweitern
07.07.2005 10:23:07
mehmet
hallo zusammen,
ich habe beide variante versucht ohne erfolg
es handelt sich um ein textbox: suchen eingabe
listbox: gefundene strings auflisten
z.z. wird der suchbereich nur in tabelle1 gemacht
kann man es nicht in allen tabellen machen?
dank und gruss
mehmet
'#######################################################################
'DieseArbeitsmappe
Option Explicit

Private Sub Workbook_Open()
GetObject ("C:\Dokumente und Einstellungen\SiM\Desktop\Blanko0.xls")
End Sub

'#######################################################################
'Tabelle1
Option Explicit
'

Private Sub ListBox1_Click()
'    Dim ws As Worksheet
'    For Each ws In Workbooks("Blanko0.xls")
'        ws.Range("A" & CStr(ListBox1.List(ListBox1.ListIndex, 1)) & ":G" & _
'        CStr(ListBox1.List(ListBox1.ListIndex, 1))).Copy ActiveSheet.Range("A1:G1")
'    Next ws
'End Sub

'

Private Sub ListBox1_Click()
'    Dim i%, z%
'    With Workbooks("Blanko0.xls")
'        For i = 1 To .Worksheets.Count
'           .Sheets(i).Range("A" & CStr(ListBox1.List(ListBox1.ListIndex, 1)) & ":G" & _
'                CStr(ListBox1.List(ListBox1.ListIndex, 1))).Copy ActiveSheet.Range("A1").Offset(z, 0)
'            z = z + 1
'        Next i
'    End With
'End Sub


Private Sub ListBox1_Click()
Workbooks("Blanko0.xls").Sheets(1).Range("A" & CStr(ListBox1.List(ListBox1.ListIndex, 1)) & ":G" & CStr(ListBox1.List(ListBox1.ListIndex, 1))).Copy ActiveSheet.Range("A1:G1")
End Sub


Private Sub TextBox1_Change()
Dim n As Integer                                             'NACHTRAG
Dim Zelle As Range, Adresse As String
ListBox1.Clear
For n = 1 To ThisWorkbook.Worksheets.Count                   'NACHTRAG
With Workbooks("Blanko0.xls").Sheets(n).Range("A2:G9999")    'NACHTRAG
'   With Workbooks("Blanko0.xls").Sheets(1).Range("A2:G9999")
Set Zelle = .Find(What:=TextBox1.Value, LookAt:=xlPart)
If Not Zelle Is Nothing Then
Adresse = Zelle.Address
Do
ListBox1.AddItem Zelle.Value
ListBox1.List(ListBox1.ListCount - 1, 1) = Zelle.Row
Set Zelle = .FindNext(Zelle)
Loop While Not Zelle Is Nothing And Zelle.Address <> Adresse
End If
End With
Next n                                                       'NACHTRAG
If Adresse <> "" Then Call sortieren(0, ListBox1.ListCount - 1)
End Sub


Private Sub sortieren(Untergrenze As Long, Obergrenze As Long)
Dim index1 As Long, index2 As Long, Element1 As String, Element2 As Long, Zwischenspeicher As String
index1 = Untergrenze
index2 = Obergrenze
Zwischenspeicher = ListBox1.List(((Untergrenze + Obergrenze) / 2) \ 1, 0)
Do
Do While ListBox1.List(index1, 0) < Zwischenspeicher
index1 = index1 + 1
Loop
Do While Zwischenspeicher < ListBox1.List(index2, 0)
index2 = index2 - 1
Loop
If index1 <= index2 Then
Element1 = ListBox1.List(index1, 0)
Element2 = ListBox1.List(index1, 1)
ListBox1.List(index1, 0) = ListBox1.List(index2, 0)
ListBox1.List(index1, 1) = ListBox1.List(index2, 1)
ListBox1.List(index2, 0) = Element1
ListBox1.List(index2, 1) = Element2
index1 = index1 + 1
index2 = index2 - 1
End If
Loop Until index1 > index2
If Untergrenze < index2 Then Call sortieren(Untergrenze, index2)
If index1 < Obergrenze Then Call sortieren(index1, Obergrenze)
End Sub

'#######################################################################
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige