VB脚本问题：循环方法需要永远 - 任何更快的方法？ [英] VB Script Question : Looping method is taking forever - any quicker ways?

问题描述

Hi Folks -

Hi Folks -

我有一个相当简单的VB脚本，用于修改excel文件以进行求和，之后我使用批处理方法将其从列转换为行。将公式添加到excel文件后，我需要在E列中找到任何空值并删除
ENTIRE行。

I have a rather simple VB Script that I use to modify an excel file for summation purposes after I transpose it from column to rows using batch methodology. After I add the formulas to the excel file, I need find any null values in Column E and delete the ENTIRE row.

该文件超过11k行，此循环技术大约需要10分钟。有没有人可以推荐的更快的方式？

The file is upwards of 11k line and this loop technique takes about 10 minutes. Is there a quicker way out there that anyone could recommend?

Set objExcel = CreateObject("Excel.Application")

Dim objexcel
Dim objworkbook1
Dim LastCell1

'::-- Declare argurments passed from batch script --::'
Dim args, LEXPPATH, EXPNAME, EXT
set args = Wscript.arguments

LEXPPATH= args(0)
EXPNAME= args(1)
EXT= args(2)

Set objworkbook1= objExcel.Workbooks.Open(LEXPPATH & EXPNAME & EXT)

'::-- Get LastCell of EXPNAME --::'
Set objWorksheet1 = objWorkbook1.Worksheets(EXPNAME)
xlUp = -4162
Set LastCell1 = objWorksheet1.Range("A" & objWorksheet1.Rows.Count).End(xlUp)

'::-- Add formula to E1 --::'
objWorkbook1.Worksheets(EXPNAME).Range("E1").Value = _
	"=IF(COUNTIFS($A1:$A$" & LastCell1.Row & ",A1,$B1:$B$" & LastCell1.Row & ",B1,$C1:$C$" & LastCell1.Row & _
		",C1)=1,SUMIFS($D$1:D1,$A$1:$A1,A1,$B$1:B1,B1,$C$1:$C1,C1),"""")"

'::-- Drag Down Formula Column E --::'
Set SourceRange = objWorksheet1.Range("E1:E1")
Set FillRange = objWorksheet1.Range("E1:E" & LastCell1.Row)
SourceRange.AutoFill FillRange

'::-- Copy concatenated cells to Column B --::'
objWorkbook1.Worksheets(EXPNAME).Range("E1:E" & LastCell1.Row).Copy
objWorkbook1.Worksheets(EXPNAME).Range("E1:E" & LastCell1.Row).PasteSpecial -4163

'::-- Loop through Column E searching for null value - if found then delete entire row --::'
	Set objWorksheet1 = objWorkbook1.Worksheets(EXPNAME)
	xlUp = -4162
	m = objWorksheet1.Range("A" & objWorksheet1.Rows.Count).End(xlUp).Row
	For r = m To 1 Step -1
		If Not InStr(objWorksheet1.Range("E" & r), "") > 0 Then
			objWorksheet1.Range("E" & r).EntireRow.Delete
		End If
	Next
		
'::-- Delete Column D with will move Column E to Column D --::'
objWorkbook1.Worksheets(EXPNAME).Range("D:D").Delete

'::-- Ensure dates are in yy-mmm format --::'
objWorkbook1.Worksheets(EXPNAME).Range("C1:C" & LastCell1.Row).NumberFormat = "yy-mmm"

objexcel.DisplayAlerts = False
objworkbook1.save
objworkbook1.close
objExcel.Quit
WScript.Quit 0

非常感谢你！

Thank you so much!

推荐答案

搜索
=

Search =

范围 。找到（ "" ）

这篇关于VB脚本问题：循环方法需要永远 - 任何更快的方法？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！