如何将bcd选项快速移动到a选项后面？

南北不相见

秋枫

用vba脚本。

南北不相见

秋枫 发表于 2018-5-21 21:49
用vba脚本。

能说的清楚点吗？第一次用

秋枫

就是用VBA写个程序啊。这个应该是很简单的一个程序。

南北不相见

秋枫 发表于 2018-5-21 21:54
就是用VBA写个程序啊。这个应该是很简单的一个程序。

emmmmm 完全不会用excel 更不要说是去写个程序了

秋枫

那到vba版块上传附件就可以了 ：）

南北不相见

秋枫 发表于 2018-5-21 22:19
那到vba版块上传附件就可以了 ：）

你的意思是在vba板块输入代码。然后excel就会自己运行处理文件是吧

南北不相见

大佬可以帮忙看一下吗？

秋枫

南北不相见 发表于 2018-5-21 22:45
大佬可以帮忙看一下吗？

合并选项.zip (1.11 KB, 下载次数: 9)

2018-5-22 09:14 上传

点击文件名下载附件

打开你的Excel文件，使之成为当前激活的窗口后（确保此文件可编辑），双击附件中提供的程序运行。
稍候片刻等进度结束。

秋枫

vbscript源代码:

1. ' the code below force script runs on cscript instead of wscript
   
2. 
   
3. Function IsCScript()
   
4.         ' Check whethe CScript.exe is the host.
   
5.         If (InStr(UCase(WScript.FullName), "CSCRIPT") <> 0) Then
   
6.                 IsCScript = True
   
7.         Else
   
8.                 IsCScript = False
   
9.         End If
   
10. End Function
    
11. 
    
12. Sub ForceInCScript()
    
13.         Dim WshShell
    
14.         Set WshShell = WScript.CreateObject("WScript.Shell")
    
15.        
    
16.         If (Not IsCScript()) Then
    
17.                 WshShell.Run "CScript.exe " & """" & WScript.ScriptFullName & """"
    
18.                 WScript.Quit ' Terminate script.
    
19.         End If
    
20. End Sub
    
21. 
    
22. ForceInCScript
    
23. 
    
24. ' This code try to connect WPS ET，if failed then connect to Excel
    
25. Dim ExcelApp
    
26. 
    
27. On Error Resume Next
    
28. ' try to connect to et or excel
    
29. Set ExcelApp = GetObject(, "Excel.Application")
    
30. If ExcelApp Is Nothing Then
    
31.         Set ExcelApp = GetObject(, "KET.Application")
    
32.         If ExcelApp Is Nothing Then
    
33.                 Set ExcelApp = GetObject(, "ET.Application")
    
34.                 If ExcelApp Is Nothing Then
    
35.                         MsgBox "Run Excel or Kingsoft ET first.", vbInformation, "Information"
    
36.                         WScript.Quit
    
37.                 End If
    
38.         End If
    
39. End If
    
40. On Error Goto 0
    
41. 
    
42. Dim Workbook, ActiveSheet
    
43. Set Workbook = ExcelApp.ActiveWorkbook
    
44. Set ActiveSheet = Workbook.ActiveSheet
    
45. 
    
46. Dim MaxRow, MaxCol
    
47. MaxRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count-1
    
48. MaxCol = ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count-1
    
49. 
    
50. If ExcelApp.ActiveWorkbook Is Nothing Then
    
51.         MsgBox "No documents was opened."
    
52.         WScript.Quit
    
53. End If
    
54. 
    
55. i=2
    
56. Do While i<=MaxRow
    
57.         If (0<>InStr("BCDEFG",Left(Trim(ActiveSheet.Cells(i,4).value),1))) _
    
58.          And (ActiveSheet.cells(i, 3).value="") Then
    
59.                 ActiveSheet.Cells(i-1,4).Value = ActiveSheet.Cells(i-1,4).value & "；" & ActiveSheet.Cells(i,4).Value
    
60.                 ActiveSheet.Cells(i-1,4).Select
    
61.                 ActiveSheet.Rows(i).Delete
    
62.                 MaxRow=MaxRow-1
    
63.                 i=i-1
    
64.                 wscript.echo "处理数据" & Round(i/MaxRow*100, 2) & "%, 第" & i & "/" & MaxRow & "行"  
    
65.         End If
    
66.         i=i+1
    
67. Loop

复制代码