近日，由于某些原因，公司部分微軟office被卸載了，裝上了wps。

原本excel中的宏在wps中不能正常使用，沒辦法，任務(wù)落到了從沒有接觸vba編程的我手中。

我安裝了wps2013個人版+vba插件。

1，問題描述

????????? Set MyPivotTable = MyPivot.PivotTableWizard(SourceType:=xlDatabase, SourceData:=Range("中間表!A1:E1" & count))

???????? 出現(xiàn)錯誤438 對象不支持該屬性或方法

??????? 本來在Excel中是沒有問題的

???????? 是不是wps不支持這些屬性？

在網(wǎng)上各種尋找答案，無果。個人分析是wps對vba支持不夠完善。

沒辦法，不能用數(shù)據(jù)透視表，就想辦法模擬數(shù)據(jù)透視表的功能。鬧了一天，鑒于本人技術(shù)不夠，沒搞定。

就看原本的數(shù)據(jù)透視表中都是什么數(shù)據(jù)，我就

Dim ts As Worksheet
Set ts = Sheets.Add
?? ?
For Each R In Worksheets
??? If R.Name = "數(shù)據(jù)透視表" Then R.Delete
Next
ts.Name = "數(shù)據(jù)透視表"
???
Sheets("中間表").Select
Columns("A:E").Select
Selection.Copy

Sheets("數(shù)據(jù)透視表").Select
ActiveSheet.Paste

Range("B:D").Delete

Dim pivCount As Integer
pivCount = Worksheets("數(shù)據(jù)透視表").Range("A65536").End(xlUp).Row

Columns("A:B").Select
Selection.Copy
ActiveSheet.Paste

就是從其他表中把相同數(shù)據(jù)放進(jìn)一張“數(shù)據(jù)透視表”中。那就沒有上述問題了，不過我這個是簡單的數(shù)據(jù)透視表。

要是特別復(fù)雜，這方法就不合適了。強(qiáng)烈建議官方完善對vba的支持。

如果有更好的解決方法，也請不吝賜教。

2，問題描述

?????? Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

?????? 這行代碼報錯不認(rèn)識PasteSpecial，我看源代碼下面有一行類似代碼沒有報錯，復(fù)制過來

????? Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
??????? SkipBlanks:=False, Transpose:=False 就一個選擇性粘貼，后來我果斷注釋了。用這個ActiveSheet.Paste好像就沒問題了

2，問題描述

???????? 剛把上面的問題解決，新的問題又來了。

???????? 運(yùn)行結(jié)果中總是少了第一行（比對在excel2003中運(yùn)行結(jié)果）

???????? 這顯然是wps的問題，因為代碼是一樣的。

??? 解決方法：找了很久，發(fā)現(xiàn)一行代碼Rows("1:2").Delete

????????????????????? 果斷改成Rows("1:1").Delete? 好像就可以了?? = =！

一些想法：1> 編程盡量什么語言都了解一點，但至少一門需要精通。

???????????????????? 2>我一向是支持國產(chǎn)的，不過wps還是有很多問題，希望繼續(xù)改進(jìn)吧。我在wps官方論壇發(fā)帖求助，沒人吊我，真是悲催！！

????????????????????????? 希望只是我一個人悲催。

下面貼上代碼

???????? 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 = "數(shù)據(jù)透視表" Then R.Delete
Next
ts.Name = "數(shù)據(jù)透視表"
?? ?
?? ?
'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 '行數(shù)
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("數(shù)據(jù)透視表").Select
ActiveSheet.Paste

Range("B:D").Delete

Dim pivCount As Integer
pivCount = Worksheets("數(shù)據(jù)透視表").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
'行數(shù)
location = Worksheets(strDep).UsedRange.Rows.count

Worksheets(strDep).Activate
For i = 3 To location
??? vlookup_str = "=IF(ISERROR(VLOOKUP(RC[-17],數(shù)據(jù)透視表!C[-17]:C[-16],2,0)),0,VLOOKUP(RC[-17],數(shù)據(jù)透視表!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? '默認(rèn)位
For i = 1 To Worksheets(strDep).UsedRange.Columns.count
??? If Cells(1, i) = "庫存" Then
??????? locColumn = i
??????? Exit For
??? End If
Next

'用選擇粘貼:公式轉(zhuǎn)數(shù)字
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 '關(guān)閉屏幕更新

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 '關(guān)閉屏幕更新
?
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("數(shù)據(jù)透視表").Delete
Worksheets("中間表").Delete

End Sub

總結(jié)

以上是生活随笔為你收集整理的WPS EXCEL中的VBA编程的全部內(nèi)容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網(wǎng)站內(nèi)容還不錯，歡迎將生活随笔推薦給好友。