WPS EXCEL中的VBA编程
近日，由于某些原因，公司部分微軟office被卸載了，裝上了wps。
原本excel中的宏在wps中不能正常使用，沒辦法，任務落到了從沒有接觸vba編程的我手中。
我安裝了wps2013個人版+vba插件。
1，問題描述
????????? Set MyPivotTable = MyPivot.PivotTableWizard(SourceType:=xlDatabase, SourceData:=Range("中間表!A1:E1" & count))
???????? 出現錯誤438 對象不支持該屬性或方法
??????? 本來在Excel中是沒有問題的
???????? 是不是wps不支持這些屬性？
在網上各種尋找答案，無果。個人分析是wps對vba支持不夠完善。
沒辦法，不能用數據透視表，就想辦法模擬數據透視表的功能。鬧了一天，鑒于本人技術不夠，沒搞定。
就看原本的數據透視表中都是什么數據，我就
Dim ts As Worksheet
Set ts = Sheets.Add
?? ?
For Each R In Worksheets
??? If R.Name = "數據透視表" Then R.Delete
Next
ts.Name = "數據透視表"
???
Sheets("中間表").Select
Columns("A:E").Select
Selection.Copy
Sheets("數據透視表").Select
ActiveSheet.Paste
Range("B:D").Delete
Dim pivCount As Integer
pivCount = Worksheets("數據透視表").Range("A65536").End(xlUp).Row
Columns("A:B").Select
Selection.Copy
ActiveSheet.Paste
就是從其他表中把相同數據放進一張“數據透視表”中。那就沒有上述問題了，不過我這個是簡單的數據透視表。
要是特別復雜，這方法就不合適了。強烈建議官方完善對vba的支持。
如果有更好的解決方法，也請不吝賜教。
2，問題描述
?????? Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
?????? 這行代碼報錯不認識PasteSpecial，我看源代碼下面有一行類似代碼沒有報錯，復制過來
????? Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
??????? SkipBlanks:=False, Transpose:=False 就一個選擇性粘貼，后來我果斷注釋了。用這個ActiveSheet.Paste好像就沒問題了
2，問題描述
???????? 剛把上面的問題解決，新的問題又來了。
???????? 運行結果中總是少了第一行（比對在excel2003中運行結果）
???????? 這顯然是wps的問題，因為代碼是一樣的。
??? 解決方法：找了很久，發現一行代碼Rows("1:2").Delete
????????????????????? 果斷改成Rows("1:1").Delete? 好像就可以了?? = =！
一些想法：1> 編程盡量什么語言都了解一點，但至少一門需要精通。
???????????????????? 2>我一向是支持國產的，不過wps還是有很多問題，希望繼續改進吧。我在wps官方論壇發帖求助，沒人吊我，真是悲催！！
????????????????????????? 希望只是我一個人悲催。
下面貼上代碼
???????? Sub Macro1(strDep As String)
Application.DisplayAlerts = False
Dim sh As Worksheet
Set sh = Sheets.Add
?? ?
For Each R In Worksheets
??? If R.Name = "中間表" Then R.Delete
Next
sh.Name = "中間表"
Dim ts As Worksheet
Set ts = Sheets.Add
?? ?
For Each R In Worksheets
??? If R.Name = "數據透視表" Then R.Delete
Next
ts.Name = "數據透視表"
?? ?
?? ?
'Dim strDep As String
'For Each r In Worksheets
'??? If VBA.Left(r.name, 3) = "RCJ" Then
'??????? strDep = r.name
'??? End If
'Next
Sheets("好件").Select
Range("A1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:=strDep, Operator:=xlAnd
Columns("A:E").Select
Selection.Copy
Sheets("中間表").Select
ActiveSheet.Paste
? ?
Dim r_count As Integer '行數
r_count = ActiveSheet.UsedRange.Rows.count
r_count = r_count + 1
Sheets("在途").Select
Range("A1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:=strDep, Operator:=xlAnd
Sheets("在途").UsedRange.Select
Selection.Copy
????? ?
Sheets("中間表").Select
Range("A" & r_count).Select
ActiveSheet.Paste
Rows(r_count).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Sheets("中間表").Select
Columns("A:E").Select
Selection.Copy
Sheets("數據透視表").Select
ActiveSheet.Paste
Range("B:D").Delete
Dim pivCount As Integer
pivCount = Worksheets("數據透視表").Range("A65536").End(xlUp).Row
Columns("A:B").Select
Selection.Copy
ActiveSheet.Paste
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False'
Dim vlookup_str As String
Dim location As Integer
'行數
location = Worksheets(strDep).UsedRange.Rows.count
Worksheets(strDep).Activate
For i = 3 To location
??? vlookup_str = "=IF(ISERROR(VLOOKUP(RC[-17],數據透視表!C[-17]:C[-16],2,0)),0,VLOOKUP(RC[-17],數據透視表!C[-17]:C[-16],2,0))"
??? Range(Cells(i, 18), Cells(i, 18)).Select
??? ActiveCell.FormulaR1C1 = vlookup_str
Next i
'定位庫存列
Dim locColumn As Integer
locColumn = 18? '默認位
For i = 1 To Worksheets(strDep).UsedRange.Columns.count
??? If Cells(1, i) = "庫存" Then
??????? locColumn = i
??????? Exit For
??? End If
Next
'用選擇粘貼:公式轉數字
Range(Cells(3, locColumn), Cells(location, locColumn)).Select
Selection.Copy
Range(Cells(3, locColumn), Cells(3, locColumn)).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'----------開始篩選----------
Application.ScreenUpdating = False '關閉屏幕更新
ActiveSheet.AutoFilterMode = False '取消前一次的自動篩選
With Rows("2:2") '篩選第二行的第6列
??? .AutoFilter
??? .AutoFilter Field:=6, Criteria1:=">0", Operator:=xlAnd
??? .AutoFilter Field:=2, Criteria1:="=*MAIN_BD*", Operator:=xlAnd
End With
?
Application.ScreenUpdating = True
Set sh = Sheets.Add
For Each R In Worksheets
??? If R.Name = strDep + "NBOK" Then R.Delete
Next
sh.Name = strDep + "NBOK"
'NBOK表
Worksheets(strDep).Activate
Columns("A:F").Select
Selection.Copy
Dim nbok_row As Integer
Sheets(strDep + "NBOK").Select
ActiveSheet.Paste
nbok_row = Worksheets(strDep + "NBOK").Range("A65536").End(xlUp).Row
If nbok_row = 1 Then
??? nbok_row = 3
Else
??? nbok_row = nbok_row + 1
End If
Worksheets(strDep).Activate
ActiveSheet.AutoFilterMode = False '取消前一次的自動篩選
With Rows("2:2") '篩選第二行的第6列
??? .AutoFilter
??? .AutoFilter Field:=6, Criteria1:=">0", Operator:=xlAnd
??? .AutoFilter Field:=1, Criteria1:="=18*", Operator:=xlAnd
End With
Columns("A:F").Select
Selection.Copy
Sheets(strDep + "NBOK").Select
Range("A" & nbok_row).Select
ActiveSheet.Paste
Rows(nbok_row).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Rows("1:1").Delete
Columns("B:E").Delete
Range("D1").Select
??? Selection.Copy
??? Columns("A:B").Select
??? Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
??????? SkipBlanks:=False, Transpose:=False
??? Application.CutCopyMode = False
'---------------------------
Set sh = Sheets.Add
For Each R In Worksheets
??? If R.Name = strDep + "NB" Then R.Delete
Next
sh.Name = strDep + "NB"
Worksheets(strDep).Activate
Application.ScreenUpdating = False '關閉屏幕更新
?
ActiveSheet.AutoFilterMode = False '取消前一次的自動篩選
With Rows("2:2") '篩選第二行的第6列
??? .AutoFilter
??? .AutoFilter Field:=6, Criteria1:=">0", Operator:=xlAnd
??? .AutoFilter Field:=2, Criteria1:="<>*MAIN_BD*", Operator:=xlAnd
??? .AutoFilter Field:=1, Criteria1:="<>18*", Operator:=xlAnd
End With
Application.ScreenUpdating = True
'NB表
Columns("A:F").Select
Selection.Copy
Sheets(strDep + "NB").Select
ActiveSheet.Paste
Rows("1:1").Delete
Columns("B:E").Delete
Range("D1").Select
??? Selection.Copy
??? Columns("A:B").Select
??? Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
??????? SkipBlanks:=False, Transpose:=False
??? Application.CutCopyMode = False
Worksheets(strDep).Activate
ActiveSheet.AutoFilterMode = False '取消前一次的自動篩選
Worksheets("數據透視表").Delete
Worksheets("中間表").Delete
End Sub
總結
以上是生活随笔為你收集整理的WPS EXCEL中的VBA编程的全部內容，希望文章能夠幫你解決所遇到的問題。
- 上一篇： CF1548B Integers Hav
- 下一篇： dsniff 和 Ettercap 和