行数据分区 - 一行中的空列值在一侧，非空在另一侧 [英] Row data partition - empty column values in a row in one side and non-empties are other side

问题描述

我想知道一个 VBscript，通过它我可以移动一侧的空行值和另一侧的非空值保持数据描述完整.这可以使用循环技术来完成.但是我想要一些更快的过程，如果可以使用 VBscript 实现的话.

I am wondering for an VBscript by which i can move the empty row values in one side and the non-empty values in the other side Keeping the data description intact.This can be done using Looping technique. But i want some faster process if any can be implemented using VBscript.

输入表

Code                Error-I                          Error-II                          Error-III



           Type-1    Type-2    Type-3        Test-A      Test-B    Test-C          Prog-A  Prog-B  Prog-C   



Code-A               Yes         No                                  Yes              X              Z     

Code-B                           No                        Yes       Yes                      Y      Z

Code-C              Yes                       Yes                     No                             Z

输出表

Code                Error-I                          Error-II                          Error-III



           Type-1    Type-2                   Test-A      Test-B                    Prog-A  Prog-B   



Code-A        Yes       No                     Yes                                     X     Z     

Code-B        No                               Yes        Yes                          Y     Z

Code-C        Yes                              Yes         No                          Z

更新:移动后，如果发现组中的某列不包含单个数据，则需要将该列从工作表中删除.

Update : After shifting if it is found that a column in a group contains not a single data,that column should need to be dropped form the sheet.

我为所有列集编写了以下代码，但它产生了不正确的数据偏移.你能说我错在哪里吗?

I wrote the below code for all sets of columns but it is producing incorrect data shifts. Can you say where i was wrong?

Option Explicit

Dim objExcel1
Dim strPathExcel1
Dim objSheet1
Dim row,col1,col2
Dim TotlColumnSet : TotlColumnSet =3
Dim AssColmuns : AssColmuns=3
Dim EachColumnSet, ColStart, ColEnd

Set objExcel1 = CreateObject("Excel.Application")
strPathExcel1 = "D:VACopy of Test.xlsx"
objExcel1.Workbooks.open strPathExcel1
Set objSheet1 = objExcel1.ActiveWorkbook.Worksheets(1)

ColStart = 2
For EachColumnSet = 1 To TotlColumnSet

  For row = 3 To 5
    ' find the first empty cell in the row
    col1 = ColStart'2
    ColEnd = ColStart + AssColmuns
    Do Until IsEmpty(objSheet1.Cells(row, col1)) Or col1 > ColEnd-1'4
      col1 = col1 + 1
    Loop

    ' collapse right-hand cells to the left
    If col1 < ColEnd-1 Then '4
      ' proceed only if first empty cell is left of the right-most cell
      ' (otherwise there's nothing to do)
      col2 = col1 + 1
      Do Until col2 > ColEnd-1'4
        ' move content of a non-empty cell to the left-most empty cell, then
        ' increment the index of the left-most empty cell (the cell right of
        ' the former left-most empty cell is now guaranteed to be empty)
        If Not IsEmpty(objSheet1.Cells(row, col2).Value) Then
          objSheet1.Cells(row, col1).Value = objSheet1.Cells(row, col2).Value
          objSheet1.Cells(row, col2).Value = Empty
          col1 = col1 + 1
        End If
        col2 = col2 + 1
      Loop
    End If
  Next

  ColStart = ColEnd

Next

'=======================
objExcel1.ActiveWorkbook.SaveAs strPathExcel1
objExcel1.Workbooks.close
objExcel1.Application.Quit
'======================    

更新:

由于错误，我没有在输出表列 Type-3、Test-C、Prog-C 中显示.但他们应该需要在场.

By Mistake i didn't show in the output table columns Type-3,Test-C,Prog-C. But they should need to be present there.

推荐答案

如果我没理解错的话，您希望将每一列折叠到左侧.如果是这样，则结果中的列标题确实具有误导性.

If I understand you correctly, you want to collapse each column set to the left. If so, the column titles in the result are indeed misleading.

工作表是否总是有 3 行，每行 3 组，每组 3 列?在这种情况下，您可以简单地使用单元格的绝对位置.第一组列的示例:

Does the sheet always have 3 rows with 3 sets of 3 columns each? In that case you could simply use the absolute positions of the cells. Example for the first set of columns:

filename = "..."

Set xl = CreateObject("Excel.Application")
xl.Visible = True

Set wb = xl.Workbooks.Open(filename)
Set ws = wb.Sheets(1)

For row = 3 To 5
  ' find the first empty cell in the row
  col1 = 2
  Do Until IsEmpty(ws.Cells(row, col1)) Or col1 > 4
    col1 = col1 + 1
  Loop

  ' collapse right-hand cells to the left
  If col1 < 4 Then
    ' proceed only if first empty cell is left of the right-most cell (otherwise
    ' there's nothing to do)
    col2 = col1 + 1
    Do Until col2 > 4
      ' move content of a non-empty cell to the left-most empty cell, then
      ' increment the index of the left-most empty cell (the cell right of the
      ' former left-most empty cell is now guaranteed to be empty)
      If Not IsEmpty(ws.Cells(row, col2).Value) Then
        ws.Cells(row, col1).Value = ws.Cells(row, col2).Value
        ws.Cells(row, col2).Value = Empty
        col1 = col1 + 1
      End If
      col2 = col2 + 1
    Loop
  End If
Next

这篇关于行数据分区 - 一行中的空列值在一侧，非空在另一侧的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！