Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

10 Ocak 2005 Pazartesi

Query




'UserForm1

'AddTools on UserForm1: Label1, Label2,ListBox1, ListBox2, Label3, Label4, Label5, Label6, Image1, Label7
Option Explicit
Dim x As Double, Query As Double, Toplam As Double
Dim Bulunan As New Collection
Dim Hücre As Range
Dim Kayıt, Kayıt_Sayısı, Alan

Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] Query ..."
Kayıt_Sayısı = WorksheetFunction.CountA(Range("Sayfa1!A3:A65536"))
With ListBox1
.ColumnCount = 3
.ColumnWidths = "60;60;60"
End With
With ListBox2
.ColumnCount = 2
.ColumnWidths = "60;60"
End With
If (Kayıt_Sayısı > 0) Then
Toplam = 0
For x = 1 To Kayıt_Sayısı
ListBox1.AddItem Cells(x + 2, 1), (x - 1)
ListBox1.List((x - 1), 1) = Cells(x + 2, 2)
ListBox1.List((x - 1), 2) = Cells(x + 2, 3)
Toplam = Toplam + Cells(x + 2, 3).Value
Next x
Label1.Caption = VBA.Format(Toplam, "#,##0.00"): Toplam = 0
Alan = "Sayfa1!A3:A" & Kayıt_Sayısı + 2
For Each Hücre In Range(Alan)
Bulunan.Add Hücre.Value, VBA.CStr(Hücre.Value)
Next Hücre
On Error GoTo 0
x = 0
Range("Sayfa1!E3").Value = ""
For Each Kayıt In Bulunan
Range("Sayfa1!E3").Value = Kayıt
Alan = "Sayfa1!A2:C" & Kayıt_Sayısı + 2
Query = WorksheetFunction.DSum(Range(Alan), 3, Range("Sayfa1!E2:F3"))
ListBox2.AddItem Kayıt
ListBox2.List(x, 1) = Query
Toplam = Toplam + Query
x = x + 1
Next Kayıt
Label2.Caption = VBA.Format(Toplam, "#,##0.00")
End If
End Sub

Hiç yorum yok:

Blog Arşivi

Bu gadget'ta bir hata oluştu

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul