在VBA中创建一个子

时间:2012-12-04 16:56:35

标签: excel-vba vba excel

如何在VBA中编写一个程序,用于扫描excel(2010)中的单元格区域,而不是告诉它扫描了多少单元格,是否有更多的数字或文本单元格,以及它找到了多少个空单元格?范围单元格将由用户定义。

这是我目前的代码:

Private Sub CommandButton1_Click()

Dim c As Range

Set c = Application.InputBox(Prompt:="A vizsgálandó cellatartomány:", Title:="Adja meg   a cellatartományt!", Default:="A1:B4", Type:=8)

Dim szam As Integer, szoveg As Integer, osszescella As Integer, ures As Integer

osszescella = c.Cells.Count '# of scanned cells

Dim rngSpec As Range

Set rngSpec = c.SpecialCells(xlCellTypeBlanks)

If Not rngSpec Is Nothing Then ures = rngSpec.Cells.Count '# of blank cells

Set rngSpec = c.SpecialCells(xlCellTypeConstants, 2)

If Not rngSpec Is Nothing Then szoveg = rngSpec.Cells.Count '# of text cells

Set rngSpec = c.SpecialCells(xlCellTypeConstants, 1)

If Not rngSpec Is Nothing Then szam = rngSpec.Cells.Count '# of numeric cells

Dim kezdocella As String

kezdocella = InputBox("Kezdő cella", "Adja meg a kezdőcellát:", "G10")

Range(kezdocella).Value = "Vizsgált cellák száma: "

Range(kezdocella).Offset(0, 1).Value = osszescella

Range(kezdocella).Offset(1, 0).Value = "Szöveges/számos van több?"

If szam > szoveg Then Range(kezdocella).Offset(1, 1).Value = "Számos" _
Else: If szoveg > szam Then Range(kezdocella).Offset(1, 1).Value = "Szöveges" _
Else Range(kezdocella).Offset(1, 1).Value = "Ugyanannyi van"

Range(kezdocella).Offset(2, 0).Value = "Üres cellák száma: "

Range(kezdocella).Offset(2, 1).Value = ures

Range(kezdocella).Offset(3, 0).Value = "Nem üres cellák száma: "

Range(kezdocella).Offset(3, 1).Value = osszescella - ures

Cells.Columns.AutoFit

End Sub

现在工作正常,谢谢Scott Holtzman。最后,它显示从用户提供的单元格开始的结果。我相信会有更好的方法来做到这一点,但我认为这也有效。

1 个答案:

答案 0 :(得分:0)

你已经开了个好头!我在下面的代码中帮助了你,并清理了一些无效的语法。这应该让你想要去......并且没有不必要的循环。

Option Explicit

Sub elsobeadando()

Dim c As Range

Set c = Application.InputBox(Prompt:="Enter Cell Range", Title:="Specify Range", Type:=8)

Dim szam As Integer, szoveg As Integer, osszescella As Integer, ures As Integer

szam = c.Cells.Count '# of scanned cells

On Error Resume Next
Dim rngSpec As Range
Set rngSpec = c.SpecialCells(xlCellTypeBlanks)

If Not rngSpec Is Nothing Then szoveg = rngSpec.Cells.Count '# of blank cells

Set rngSpec = c.SpecialCells(xlCellTypeConstants, 2)

If Not rngSpec Is Nothing Then osszescella = rngSpec.Cells.Count '# of text cells

Set rngSpec = c.SpecialCells(xlCellTypeConstants, 1)

If Not rngSpec Is Nothing Then ures = rngSpec.Cells.Count '# of numeric cells

'not sure if this maps up with the above because, well ... I don't understand hungarian! :)
'also cleaned this up a bit to be actual VBA syntax
Range("D10").Value = osszescella
If szam > szoveg Then Range("D11").Value = "Több számos cella volt, mint szöveges"
Range("D12").Value = ures
Range("D13").Value = osszescella - ures

End Sub