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

Published by

风君子

独自遨游何稽首 揭天掀地慰生平

发表回复

您的电子邮箱地址不会被公开。 必填项已用 * 标注