comboboxa sayfadan veri alma ve sayfadaki alınan veriyi silme

[maras321]

arkadaşlar ekteki userforma bakarsanız ne demek istediğimi anlarsınız bir kaç başlık altında topladım şimdiden teşekkürler.....

 

[Orion1]

Dosyanız ekte.

Private Sub UserForm_Initialize()
Dim alan As Range, hcr As Range, sat As Long, i As Long
Sheets("Sayfa2").Select
ComboBox1.ColumnWidths = "0;100"
ReDim myarr(1 To 2, 1 To 1)
For i = 1 To 8
    sat = Cells(65536, i).End(xlUp).Row
    If sat < 7 Then GoTo atla
    Set alan = Range(Cells(7, i), Cells(sat, i))
    For Each hcr In alan
        If hcr.Value <> Empty Then
            a = a + 1
            ReDim Preserve myarr(1 To 2, 1 To a)
            myarr(1, a) = hcr.Address
            myarr(2, a) = hcr.Value
        End If
    Next hcr
atla:
Next i
ComboBox1.Column = myarr
If ComboBox1.ListCount > 0 Then ComboBox1.ListIndex = 0
Set alan = Nothing
End Sub

 

[maras321]

Dosyanız ekte.

hocam çok teşekkürler......

 

[Orion1]

hocam çok teşekkürler......

Rica ederim.
İyi çalışmalar.

 

[Orion1]

Dosyada bir mantık hatası vardı.Düzenledim 2numaralı mesajdan yeni dosyayı indirebilirsiniz.

 

[asterix1234]

Dosyanız ekte.

Private Sub UserForm_Initialize()
Dim alan As Range, hcr As Range, sat As Long, i As Long
Sheets("Sayfa2").Select
ComboBox1.ColumnWidths = "0;100"
ReDim myarr(1 To 2, 1 To 1)
For i = 1 To 8
    sat = Cells(65536, i).End(xlUp).Row
    If sat < 7 Then GoTo atla
    Set alan = Range(Cells(7, i), Cells(sat, i))
    For Each hcr In alan
        If hcr.Value <> Empty Then
            a = a + 1
            ReDim Preserve myarr(1 To 2, 1 To a)
            myarr(1, a) = hcr.Address
            myarr(2, a) = hcr.Value
        End If
    Next hcr
atla:
Next i
ComboBox1.Column = myarr
If ComboBox1.ListCount > 0 Then ComboBox1.ListIndex = 0
Set alan = Nothing
End Sub

Evren Bey, peki bu listelemede sadece A,C ve E sütunlarını görebilirmiyiz Mümkün mü ?

 

[Orion1]

Evren Bey, peki bu listelemede sadece A,C ve E sütunlarını görebilirmiyiz Mümkün mü ?

İşte Kodlar.

Private Sub UserForm_Initialize()
Dim alan As Range, hcr As Range, sat As Long, i As Long
Sheets("Sayfa2").Select
ComboBox1.ColumnCount = 2
ComboBox1.ColumnWidths = "0;100"
sut = Array(0, 1, 3, 5)

ReDim myarr(1 To 2, 1 To 1)
For i = 1 To 3
    sat = Cells(65536, CInt(sut(i))).End(xlUp).Row
    If sat < 7 Then GoTo atla
    Set alan = Range(Cells(7, CInt(sut(i))), Cells(sat, CInt(sut(i))))
    For Each hcr In alan
        If hcr.Value <> Empty Then
            a = a + 1
            ReDim Preserve myarr(1 To 2, 1 To a)
            myarr(1, a) = hcr.Address
            myarr(2, a) = hcr.Value
        End If
    Next hcr
atla:
Next i
ComboBox1.Column = myarr
If ComboBox1.ListCount > 0 Then ComboBox1.ListIndex = 0
Set alan = Nothing
End Sub

 

[asterix1234]

İşte Kodlar.

Private Sub UserForm_Initialize()
Dim alan As Range, hcr As Range, sat As Long, i As Long
Sheets("Sayfa2").Select
ComboBox1.ColumnCount = 2
ComboBox1.ColumnWidths = "0;100"
sut = Array(0, 1, 3, 5)

ReDim myarr(1 To 2, 1 To 1)
For i = 1 To 3
    sat = Cells(65536, CInt(sut(i))).End(xlUp).Row
    If sat < 7 Then GoTo atla
    Set alan = Range(Cells(7, CInt(sut(i))), Cells(sat, CInt(sut(i))))
    For Each hcr In alan
        If hcr.Value <> Empty Then
            a = a + 1
            ReDim Preserve myarr(1 To 2, 1 To a)
            myarr(1, a) = hcr.Address
            myarr(2, a) = hcr.Value
        End If
    Next hcr
atla:
Next i
ComboBox1.Column = myarr
If ComboBox1.ListCount > 0 Then ComboBox1.ListIndex = 0
Set alan = Nothing
End Sub

Evren bey, kodları ekledim fakat bir hata kodu veriyor..
run-time error 9
Subscript out of range

seçim yapamıyor galiba örneği eklerseniz sevinirim ellerinize sağlık

 

[Orion1]

Dosya ekte.

Private Sub UserForm_Initialize()
Dim alan As Range, hcr As Range, sat As Long, i As Long
Sheets("Sayfa2").Select
ComboBox1.ColumnCount = 2
ComboBox1.ColumnWidths = "0;100"
sut = Array(0, 1, 3, 5)

ReDim myarr(1 To 2, 1 To 1)
For i = 1 To 3
    sat = Cells(65536, CInt(sut(i))).End(xlUp).Row
    If sat < 7 Then GoTo atla
    Set alan = Range(Cells(7, CInt(sut(i))), Cells(sat, CInt(sut(i))))
    For Each hcr In alan
        If hcr.Value <> Empty Then
            a = a + 1
            ReDim Preserve myarr(1 To 2, 1 To a)
            myarr(1, a) = hcr.Address
            myarr(2, a) = hcr.Value
        End If
    Next hcr
atla:
Next i
If a > 0 Then
    ComboBox1.Column = myarr
    ComboBox1.ListIndex = 0
End If
Erase myarr
Set alan = Nothing
End Sub

 

[asterix1234]

Dosya ekte.

Private Sub UserForm_Initialize()
Dim alan As Range, hcr As Range, sat As Long, i As Long
Sheets("Sayfa2").Select
ComboBox1.ColumnCount = 2
ComboBox1.ColumnWidths = "0;100"
sut = Array(0, 1, 3, 5)

ReDim myarr(1 To 2, 1 To 1)
For i = 1 To 3
    sat = Cells(65536, CInt(sut(i))).End(xlUp).Row
    If sat < 7 Then GoTo atla
    Set alan = Range(Cells(7, CInt(sut(i))), Cells(sat, CInt(sut(i))))
    For Each hcr In alan
        If hcr.Value <> Empty Then
            a = a + 1
            ReDim Preserve myarr(1 To 2, 1 To a)
            myarr(1, a) = hcr.Address
            myarr(2, a) = hcr.Value
        End If
    Next hcr
atla:
Next i
If a > 0 Then
    ComboBox1.Column = myarr
    ComboBox1.ListIndex = 0
End If
Erase myarr
Set alan = Nothing
End Sub

Evren bey, ben hiçbirşey anlamadım. Daha önce gönderdiğiniz örnek ile bu örnekle bağlantısını anlayamadım. Daha önceki örnek departmana göre listeleme yapıyordu ama sadece departmanın olduğu sütunu alıyordu ben sadece aynı işleme devam etsin ama bahsettiğim sütunlarıda göstermesini rica etmiştim..

 

[asterix1234]

Evren bey, ben hiçbirşey anlamadım. Daha önce gönderdiğiniz örnek ile bu örnekle bağlantısını anlayamadım. Daha önceki örnek departmana göre listeleme yapıyordu ama sadece departmanın olduğu sütunu alıyordu ben sadece aynı işleme devam etsin ama bahsettiğim sütunlarıda göstermesini rica etmiştim..

kendimi kaptırmışım pardon, farklı konuya yazmışım
kusura bakmayın gereksiz yere uğraşrdım..