Új hozzászólás Aktív témák

• #6060 Fire/SOUL/CD félisten Bicé #6057

  Új Válasz 2010-01-15 14:45:34 #6060

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Fire/SOUL/CD

  félisten

  válasz Bicé #6057 üzenetére

  Hali!

  Mint előbb ulrik19 említette, más megoldást kell választanod.
  Nem írtad, mennyire vagy jártas VBA-ban, úgy hogy nem biztos hogy ez a kód segít.
  Ez Listbox-al dolgozik, ami a Munka1 lapon van ListBox1 néven, az adatok amikkel kitölti(üres cellákat kihagyja), az meg a Munka2, A oszlopában (bármelyikben lehet, csak módosítani kell egy elég egyértelmű sorban) A kód a munkafüzet megnyitásakor fut le, de a későbbiekben szükséges lesz belőle szubrutint készítened, hisz több esetben is szükség lesz, hogy lefusson.(Például, amikor módosítasz az adatokon)

  Private Sub Workbook_Open()
  
  Dim MySrcColumn As String
  Dim MySrcSheet As String, MyDestSheet As String
  Dim SourceRange As Range
  Dim LB1 As Object
  
  Application.ScreenUpdating = False
  
  MySrcSheet = "Munka2"
  MySrcColumn = "A"
  MyDestSheet = "Munka1"
  
  Set LB1 = Sheets(MyDestSheet).ListBox1
  
  Sheets(MySrcSheet).Activate
  
  MyUsedRange = Range(MySrcColumn & "65536").End(xlUp).Row
  Set SourceRange = Sheets(MySrcSheet).Range(MySrcColumn & "1:" & MySrcColumn & MyUsedRange)
  LB1.Clear
  LB1.MultiSelect = fmMultiSelectExtended
  For i = 0 To SourceRange.Rows.Count - 1
  MyItem = Cells(SourceRange.Row + i, SourceRange.Column)
  If Not IsEmpty(MyItem) Then
  LB1.AddItem MyItem
  End If
  Next i
  Sheets(MyDestSheet).Activate
  
  Application.ScreenUpdating = True
  
  End Sub

  Fire.

Új hozzászólás Aktív témák