作者ceendy (啊呜~)
看板Visual_Basic
标题[VBA ] Clear Range的问题
时间Wed Mar 29 03:38:29 2006
我其实没有很懂 VB 程式码 是初学者 拜托前辈指教一下
这个VBA程式 是要筛选资料的
把每天的股价资料读进来後 筛完就把这天资料clear掉
但是在按clear键後 800行之後的资料都无法删除 超怪的
请高手们帮我看一下 谢谢了!!!
Private Sub clear_Click()
ThisWorkbook.Sheets("temp").Range("rawdata").ClearContents
ThisWorkbook.Sheets("final").Range("rec").ClearContents
End Sub
Private Sub CommandButton1_Click()
Set daterange = ThisWorkbook.Sheets("para").Range("daterange")
Application.Calculation = xlCalculationManual
ThisWorkbook.Sheets("temp").Range("rawdata").ClearContents
Set stkrange = ThisWorkbook.Sheets("para").Range("stkrange")
Set daterange = ThisWorkbook.Sheets("para").Range("daterange")
Set rawdata = ThisWorkbook.Sheets("temp").Range("rawdata")
Set rec = ThisWorkbook.Sheets("final").Range("rec")
b = 1
While daterange.Cells(b, 1) <> ""
b = b + 1
Wend
c = 1
While stkrange.Cells(c, 1) <> ""
c = c + 1
Wend
num = 1
While rec.Cells(num, 1) <> ""
num = num + 1
Wend
For i = 1 To b - 1
For j = 1 To c - 1
ThisWorkbook.Sheets("temp").Range("rawdata").ClearContents
With ActiveSheet.QueryTables.Add(Connection:="TEXT;D:\nsefo\" & daterange(i, 1) & ".bhv" _
, Destination:=Sheets("temp").Range("A1"))
.Name = daterange(i, 1)
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = False
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
End With
'ActiveWorkbook.Names("_" & daterange(i, 1)).Delete
a = 1
While rawdata.Cells(a, 1) <> ""
a = a + 1
Wend
For k = 1 To a - 1
If rawdata.Cells(k, 2) = stkrange(j, 1) And rawdata.Cells(k, 3) = "FUTSTK" Then
rec.Cells(num, 1) = rawdata.Cells(k, 1)
rec.Cells(num, 2) = rawdata.Cells(k, 2)
rec.Cells(num, 3) = rawdata.Cells(k, 3)
rec.Cells(num, 4) = rawdata.Cells(k, 4)
rec.Cells(num, 5) = rawdata.Cells(k, 5)
rec.Cells(num, 6) = rawdata.Cells(k, 6)
rec.Cells(num, 7) = rawdata.Cells(k, 7)
rec.Cells(num, 8) = rawdata.Cells(k, 8)
rec.Cells(num, 9) = rawdata.Cells(k, 9)
rec.Cells(num, 10) = rawdata.Cells(k, 10)
rec.Cells(num, 11) = rawdata.Cells(k, 11)
rec.Cells(num, 12) = rawdata.Cells(k, 12)
rec.Cells(num, 13) = rawdata.Cells(k, 13)
rec.Cells(num, 14) = rawdata.Cells(k, 14)
rec.Cells(num, 15) = rawdata.Cells(k, 15)
rec.Cells(num, 16) = rawdata.Cells(k, 16)
'rec.Cells(num, 17) = rawdata.Cells(k, 17)
num = num + 1
End If
Next k
Next j
Next i
Application.Calculation = xlCalculationManual
End Sub
--
※ 发信站: 批踢踢实业坊(ptt.cc)
◆ From: 218.167.74.137
1F：推 sueadolph:从头到尾没看到 Range("rawdata")的定义..... 03/31 02:29
2F：→ sueadolph:这部份可以在EXCEL档案上头先行设定 03/31 02:30
3F：→ sueadolph:请先看一下你的EXCEL档 有没有区域叫 rawdata的 03/31 02:30
4F：→ sueadolph:然後....某些录制後..不影响结果的多余程式码 请删除= = 03/31 02:31
5F：→ sueadolph:哦~对了rawdata的找法是..在EXCEL的fx 左边有个小箭头 03/31 02:33
6F：→ ceendy:感谢你 我有发现到 哈哈 的确没定义这个 thank you 03/31 22:42
7F：→ ceendy:呵 我会好好练习写程式的好习惯吧 :p 03/31 22:42