• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Tarihleri sıralama

O

osmanucel

Katılım
26 Ocak 2010
Mesajlar
190
Excel Vers. ve Dili
2010 turkçe
Private Sub CommandButton1_Click()
Dim sat As Long, sh As Worksheet, sf()
Sheets("RAPOR").Select
Range("B5:N" & Rows.Count).Clear
Application.ScreenUpdating = False
sf = Array("", "ALIŞ", "SATIŞ", "KASA")
For i = 1 To 3
Set sh = Sheets(sf(i))
sh.Range("B4").AutoFilter
sh.Range("B4").AutoFilter field:=5, Criteria1:=TextBox1.Text & "*"
If WorksheetFunction.Subtotal(103, sh.Range("B5:B" & sh.Rows.Count)) > 0 Then
sat = Cells(Rows.Count, "B").End(xlUp).Row + 1
sh.Range("B4").CurrentRegion.Offset(1, 0).Copy
Range("B" & sat).PasteSpecial (xlPasteValuesAndNumberFormats)
End If
Application.CutCopyMode = False
sh.Range("B4").AutoFilter
Set sh = Nothing
Next i
Application.ScreenUpdating = True
Unload Me
MsgBox "İşlem tamamlanmıştır." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
End Sub


bu kodu b sütununda tarıh bölumu vartarıh sırasına göre sırala komutu ekleyebılırmıyız
 
yanıt

Kod: 
Private Sub CommandButton1_Click()
Dim sat As Long, sh As Worksheet, sf()
Sheets("RAPOR").Select
Range("B5:N" & Rows.Count).Clear
Application.ScreenUpdating = False
sf = Array("", "ALIŞ", "SATIŞ", "KASA")
For i = 1 To 3
Set sh = Sheets(sf(i))
sh.Range("B4").AutoFilter
sh.Range("B4").AutoFilter field:=5, Criteria1:=TextBox1.Text & "*"
If WorksheetFunction.Subtotal(103, sh.Range("B5:B" & sh.Rows.Count)) > 0 Then
sat = Cells(Rows.Count, "B").End(xlUp).Row + 1
sh.Range("B4").CurrentRegion.Offset(1, 0).Copy
Range("B" & sat).PasteSpecial (xlPasteValuesAndNumberFormats)
[COLOR="Blue"]Range("b5:n" & Rows.Count).Sort key1:=[b5], order1:=xlAscending[/COLOR]
End If
Application.CutCopyMode = False
sh.Range("B4").AutoFilter
Set sh = Nothing
Next i
Application.ScreenUpdating = True
Unload Me
MsgBox "İşlem tamamlanmıştır." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
End Sub
 
Hocam ıkıncı defa rapor almaya kalktıgımda
devamına ıslıyo eskı bılgılerı sılıp yenısını yazmıyo
 
Sub Raporla()

Dim c As Range, sat As Long, Adr As Variant, i As Integer

Application.ScreenUpdating = False

Sheets("RAPOR").Select
Rows("4:" & Rows.Count).Clear

Sheets("KASA").Range("B4:N5").Copy Range("A4")

sat = 6
For i = 1 To Worksheets.Count
With Sheets(i)
If .Name <> "RAPOR" Then
Set c = .[F:F].Find(Range("A1"), , xlValues, xlWhole)
If Not c Is Nothing Then
Adr = c.Address
Do
.Range("B" & c.Row, "N" & c.Row).Copy Range("A" & sat)
sat = sat + 1
Set c = .[F:F].FindNext(c)
Loop While Not c Is Nothing And c.Address <> Adr
End If
End If
End With
Next i

Range("A6:N" & Rows.Count).Sort Range("A6"), xlAscending
[B:N].EntireColumn.AutoFit
Application.ScreenUpdating = True

End Sub
 
Bo kodu combobox a uyarlayabılırmıyız bakabılırmısınız
 
Sub Raporla()

Dim c As Range, sat As Long, Adr As Variant, i As Integer

Application.ScreenUpdating = False

Sheets("RAPOR").Select
Rows("4:" & Rows.Count).Clear

Sheets("KASA").Range("B4:N5").Copy Range("A4")

sat = 6
For i = 1 To Worksheets.Count
With Sheets(i)
If .Name <> "RAPOR" Then
Set c = .[F:F].Find(Range("A1"), , xlValues, xlWhole)
If Not c Is Nothing Then
Adr = c.Address
Do
.Range("B" & c.Row, "N" & c.Row).Copy Range("A" & sat)
sat = sat + 1
Set c = .[F:F].FindNext(c)
Loop While Not c Is Nothing And c.Address <> Adr
End If
End If
End With
Next i

Range("A6:N" & Rows.Count).Sort Range("A6"), xlAscending
[B:N].EntireColumn.AutoFit
Application.ScreenUpdating = True

End Sub


BU KODU combobox la user forma uyarlamayı düşünüyorum
 
userform

Sub Raporla()

Dim c As Range, sat As Long, Adr As Variant, i As Integer

Application.ScreenUpdating = False

Sheets("RAPOR").Select
Rows("4:" & Rows.Count).Clear

Sheets("KASA").Range("B4:N5").Copy Range("A4")

sat = 6
For i = 1 To Worksheets.Count
With Sheets(i)
If .Name <> "RAPOR" Then
Set c = .[F:F].Find(Range("A1"), , xlValues, xlWhole)
If Not c Is Nothing Then
Adr = c.Address
Do
.Range("B" & c.Row, "N" & c.Row).Copy Range("A" & sat)
sat = sat + 1
Set c = .[F:F].FindNext(c)
Loop While Not c Is Nothing And c.Address <> Adr
End If
End If
End With
Next i

Range("A6:N" & Rows.Count).Sort Range("A6"), xlAscending
[B:N].EntireColumn.AutoFit
Application.ScreenUpdating = True

End Sub
 
bu kodu combobox la userforma nasıl ayarlıyabılırım
a1 hucresı degılde userformda combobox a gore ayarlayabılırmıyız
 
Merhaba,

Sorunuzu küçük bir örnek dosya ile destekleyip açıklarmısınız.

Not: Aynı konuyla ilgili birden fazla konu başlığı açmamanızı, ayrıca açtığınız konuların başlığını sorunun içeriğini ifade edecek şekilde belirlemeye özen göstermenizi rica ederim.

.
 
Haklısınız ömer bey özur dılerım
ya exelde yenıyım muhasebecıyım ondan heyecanım kusuruma bakmayın
 
Formun rapor kısmına bu kodu combobox yon vererek exele raporlamasını ısdıyorumkodu comboboxsa uyarlamak
 
Sadece sorunuzun bölümünü küçük bir örnek hazırlayarak açıklayamazsınız. İnanın dosyanın içinde kayboldum. Fazlaca menü ve sayfa var. Tek tek bunları inceleyip ayıklayacak zamanım yok maalesef.
 
Ayrıyeten sayfaya da yazacak mı?
 
Formun içindeki eski kodları silin ve aşağıdaki kodları yazın.

Kod: 
Private Sub Raporla()
 
    Dim c As Range, sat As Long, Adr As Variant, i As Integer
 
    Application.ScreenUpdating = False
 
    Sheets("RAPOR").Select
    Rows("4:" & Rows.Count).Clear
 
    Sheets("KASA").Range("B4:N5").Copy Range("A4")
    Range("A1") = ComboBox1.Value
 
    sat = 6
    For i = 1 To Worksheets.Count
        With Sheets(i)
            If .Name <> "RAPOR" Then
                Set c = .[F:F].Find(Range("A1"), , xlValues, xlWhole)
                If Not c Is Nothing Then
                  Adr = c.Address
                    Do
                      .Range("B" & c.Row, "N" & c.Row).Copy Range("A" & sat)
                      sat = sat + 1
                      Set c = .[F:F].FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> Adr
                End If
            End If
        End With
    Next i
 
    Range("A6:N" & Rows.Count).Sort Range("A6"), xlAscending
 
    [B:N].EntireColumn.AutoFit
    Application.ScreenUpdating = True
 
End Sub
 
Private Sub CommandButton1_Click()
 
    Dim son As Long
 
    Raporla
 
    Sheets("RAPOR").Select
    son = Cells(Rows.Count, "A").End(xlUp).Row
 
    With ListBox1
        .ColumnCount = 13
        .ColumnWidths = "90;90;90;90;90;90;90;90;90;90;90;90;90"
    End With
 
    ListBox1.RowSource = "'RAPOR'!A4:M" & son
 
End Sub
 
Private Sub UserForm_Initialize()
 
    Dim i As Integer, hucre, syf As Worksheet, j As Integer
    Dim dizi(), d As Object
 
    dizi = Array("", "ALIŞ", "SATIŞ", "KASA")
 
    Set d = CreateObject("Scripting.Dictionary")
 
    For j = 1 To 3
        Set syf = Sheets(dizi(j))
        With syf
            For i = 5 To .Cells(Rows.Count, "F").End(xlUp).Row
                hucre = .Cells(i, "F")
                If hucre <> "" Then
                    If Not d.exists(hucre) Then d.Add hucre, Nothing
                End If
            Next i
        End With
    Next j
 
    ComboBox1.List = d.keys
 
End Sub

.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst