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编程相关推荐

vba编程把纯文本转换成html,如何将一列文本与html标签转换为Excel中的vba格式文本...
我想知道如何使用VBA脚本将带有html标签的整列单元转换为格式化文本(基于这些标签).如何将一列文本与html标签转换为Excel中的vba格式文本使用下列内容: Sub Sample() Dim ...
工具推荐：用VS code 导出、导入和运行Excel中的VBA代码
问题如何使用Excel的VBA 编辑器以外的IDE来编辑VBA代码? 如何导入/导出Excel中的VBA代码? 我能不能在Excel以外的地方运行VBA代码? 如何把Excel中的VBA工程/代码上 ...
在EXCEL下用VBA编程提高人事数据的管理效率
一.概述人力资源部承载着企业人员劳资.人事.培训.社保.档案及文件的大量数据信息,而且信息量随时间不断积累,不断地做阶段"积分"工作--汇总统计.存档,有时做"微分&q ...
vba mysql 自动化错误_在Excel中运行VBA脚本时出现自动化错误
在Excel 2007中运行VBA代码时出现自动化错误.我尝试连接到远程SQL Server数据库并将数据从Excel加载到SQL Server.在Excel中运行VBA脚本时出现自动化错误我得到的 ...
中文版Excel 2007高级VBA编程宝典
中文版Excel 2007高级VBA编程宝典转载于:https://www.cnblogs.com/gavinhughhu/archive/2009/12/04/1616672.html
excel中定义VBA
http://zhidao.baidu.com/question/127778044 Sub apm() End Sub Function ampm(cel As String) Dim tex As ...
在Excel中通过VBA实现不定区域的标准差计算
需求:在excel中计算固定区域的均值有很多实现方式,但是对于跟随一定条件变化的区域,要求解标准差却很难实现. 解决方案:通过VBA的程序,根据条件改变选定的单元格区域,实现不定区域的标准差计算. 程 ...
wps excel中怎样对比两列中的数据，并且把相同的数据粘贴在结果列。
应项目需要,要对导入数据同excel数据进行比对. 之前用同事电脑用office比对过,我自己电脑只有wps,首次用wps进行数据比对. 1.将要比对的数据置于同一个excel中 2.在结果列输入函数 ...
Excel中的VBA学习--简易上手VB的程序
记录一下自己第一次接触VBA. 需求:Excel单元格的内容中存在空行,希望删除这些空行.如下图此时可借助excel的函数达到目的: =CONCAT(LEFT(A2,FIND(" &quo ...

WPS EXCEL中的VBA编程

WPS EXCEL中的VBA编程相关推荐

最新文章

热门文章