行数据分区 - 一侧的行中的空列值，而不是空的 [英] Row data partition - empty column values in a row in one side and non-empties are other side
问题描述
输入表
代码错误-I错误-II错误-III
Type-1 Type- 2 Type-3 Test-A Test-B Test-C Prog-A Prog-B Prog-C
代码A是否是XZ
代码B否是是YZ
代码C是是否Z
输出表
II错误-III
Type-1 Type-2测试A测试B Prog-A Prog-B
代码A是否是XZ
代码B否是是YZ
代码C是是否Z
更新 ：如果发现组中的列不包含单个数据，则在转换后，该列应该从表单中删除。
我为所有列列写了下面的代码，但是它产生的数据不正确。你可以说我错了吗？
Option Explicit
Dim objExcel1
Dim strPathExcel1
Dim objSheet1
Dim row，col1，col2
Dim TotlColumnSet：TotlColumnSet = 3
Dim AssColmuns：AssColmuns = 3
Dim EachColumnSet，ColStart，ColEnd
设置objExcel1 = CreateObject（Excel.Application）
strPathExcel1 =D：\VA\Copy of Test.xlsx
objExcel1.Workbooks.open strPathExcel1
设置objSheet1 = objExcel1.ActiveWorkbook.Worksheets（1）
ColStart = 2
对于EachColumnSet = 1 To TotlColumnSet
对于row = 3到5
'找到行中的第一个空单元格
col1 = ColStart'2
ColEnd = ColStart + AssColmuns
直到IsEmpty（objSheet1.Cells（row，col1））或col1> ColEnd-1'4
col1 = col1 + 1
循环
'向右折叠右侧单元格
如果col1 < ColEnd-1然后'4
'只有当第一个空单元格留在最右边的单元格
'时才进行（否则无关紧要）
col2 = col1 + 1
直到col2> ColEnd-1'4
'将非空单元格的内容移动到最左边的空单元格，然后
'增加最左边空单元格的索引（单元格右边的
'前左最空的单元格现在保证为空）
如果不是IsEmpty（objSheet1.Cells（row，col2）.Value）然后
objSheet1.Cells（row，col1）.Value = objSheet1.Cells（row，col2）.Value
objSheet1.Cells（row，col2）.Value = Empty
col1 = col1 + 1
End If
col2 = col2 + 1
循环
结束如果
下一个
ColStart = ColEnd
下一个
'== ===================
objExcel1.ActiveWorkbook.SaveAs strPathExcel1
objExcel1.Workbooks.close
objExcel1.Application.Quit
'====================
更新：
由于Mistake我没有在输出表列中显示Type 3，测试-C，PROG-C。但他们应该在那里出席。
如果我正确理解你，你想要折叠左边的每一列。如果是这样，结果中的列标题确实具有误导性。
表格总是有3行，每列3列3列吗？在这种情况下，您可以简单地使用单元格的绝对位置。第一组列的示例：
filename =...
设置xl = CreateObject（Excel.Application）
xl.Visible = True
设置wb = xl.Workbooks.Open（filename）
设置ws = wb.Sheets（1）
对于行= 3到5
'找到行中的第一个空单元格
col1 = 2
直到IsEmpty（ws.Cells（row，col1））或col1> 4
col1 = col1 + 1
循环
'向左折叠右侧单元格
如果col1< 4然后
'只有当第一个空单元格留在最右边的单元格（否则
'无关）
col2 = col1 + 1
直到col2> ; 4
'将非空单元格的内容移动到最左空单元格，然后
'增加最左边空单元格的索引（
'前面的单元格右最左边的空单元现在保证为空）
如果不是IsEmpty（ws.Cells（row，col2）.Value）然后
ws.Cells（row，col1）.Value = ws.Cells （row，col2）.Value
ws.Cells（row，col2）.Value = Empty
col1 = col1 + 1
End If
col2 = col2 + 1
循环
结束如果
下一个
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.
Input Sheet
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
Output Sheet
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:\VA\Copy 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
'======================
Update:
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.
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屋！
