Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

1 Nisan 2009 Çarşamba

Transport Non-Empty Rows To The List And Delete Blank Lines




'UserForm1

'Add Tools on UserForm1: Image1, Label1, Label2, Label3, ListBox1, CommandButton1
Option Explicit
Dim i As Single, No As Double
Dim Hücre As Range, Alan As Range, ÖzelAlan As Range
Dim Bulunan As String

Private Sub UserForm_Initialize()
On Error Resume Next
With Me
.Caption = "[PBİD®]Transport Non-Empty Rows To The List And Delete Blank Lines"
.width = 460
.height = 289
.BackColor = &H80000016
End With
With ListBox1
.ColumnCount = 2
.ColumnWidths = "42;389"
.Font.Size = 8
End With
Application.Visible = True
End Sub
Private Sub UserForm_Activate()
On Error Resume Next
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error Resume Next
Application.Visible = True
End Sub
Private Sub CommandButton1_Click()
On Error Resume Next
Call DoluSatırlarıListeyeTaşıma
Call BoşSatırlarıSilme
End Sub
Sub DoluSatırlarıListeyeTaşıma() '[Transport non-empty rows to the list]
On Error Resume Next
No = 0
Set Alan = Range(Cells(2, 1), Cells([A65536].End(xlUp).Row, 1))
Bulunan = Alan.Address
Set ÖzelAlan = Alan.SpecialCells(xlCellTypeConstants)
With ListBox1
.Clear
For Each Hücre In ÖzelAlan
.AddItem Hücre.Value
.List(No, 1) = Hücre.Offset(0, 1)
No = No + 1
Next Hücre
End With
End Sub
Sub BoşSatırlarıSilme() '[Delete Blank Lines]
On Error Resume Next
Set Alan = Range(Cells(2, 1), Cells([A65536].End(xlUp).Row, 2))
Bulunan = Alan.Address
Set ÖzelAlan = Alan.SpecialCells(xlCellTypeBlanks)
ÖzelAlan.Delete
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