近日，由于某些原因，公司部分微软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
支付宝扫一扫
微信扫一扫
