宏中用于将行转换为列的问题 [英] problem in macro for transforming row to column

问题描述

你好朋友，

我是VBA的新手，当我将muliple行转换为列时，rng变量没有更新而且我的工作表已损坏

代码是如下所示。请指示我在哪里更改...

hello friends,
I am new in VBA,when i am transforming muliple row to column that time rng variable not updating and my sheet is corrupt
the code is like below.please suggest me where to change...

Public Sub coltorow()
Dim rng As Range
Dim i As Long
Dim lastrow As Long
lastrow = Cells(Rows.count, 1).End(xlUp).Row
Set rng = Range(Cells(1, "A"), Cells(lastrow, "A")).SpecialCells(xlCellTypeConstants)
 'Sheet1.Columns("D:Z").ColumnWidth = 21

For i = 1 To rng.Areas.count
        Sheet2.Cells(i + 38, "D").Resize(1, rng.Areas(i).count).Value = Application.WorksheetFunction.Transpose(rng.Areas(i))
        'Sheet2.Cells(i + 45, "W").Resize(1, rng.Areas(i).Count).Value = Application.WorksheetFunction.Transpose(rng.Areas(i))
Next i
End Sub
Public Sub Coltorow1()
Dim rng As Range
Dim i As Long
Dim lastrow As Long
lastrow = Cells(Rows.count, 1).End(xlUp).Row
Set rng = Range(Cells(1, "B"), Cells(lastrow, "B")).SpecialCells(xlCellTypeConstants)
 'Sheet1.Columns("D:Z").ColumnWidth = 21

For i = 1 To rng.Areas.count
        Sheet2.Cells(i + 39, "D").Resize(1, rng.Areas(i).count).Value = Application.WorksheetFunction.Transpose(rng.Areas(i))
        'Sheet2.Cells(i + 45, "W").Resize(1, rng.Areas(i).Count).Value = Application.WorksheetFunction.Transpose(rng.Areas(i))
Next i

End Sub
Public Sub coltorow2()
Dim rng As Range
Dim i As Long
Dim lastrow As Long
lastrow = Cells(Rows.count, 1).End(xlUp).Row
Set rng = Range(Cells(1, "D"), Cells(lastrow, "D")).SpecialCells(xlCellTypeConstants)
 'Sheet1.Columns("D:Z").ColumnWidth = 21

For i = 1 To rng.Areas.count
        Sheet2.Cells(i + 41, "D").Resize(1, rng.Areas(i).count).Value = Application.WorksheetFunction.Transpose(rng.Areas(i))
        'Sheet2.Cells(i + 45, "W").Resize(1, rng.Areas(i).Count).Value = Application.WorksheetFunction.Transpose(rng.Areas(i))
Next i

End Sub
Public Sub coltorow3()
Dim rng As Range
Dim i As Long
Dim lastrow As Long
lastrow = Cells(Rows.count, 1).End(xlUp).Row
Set rng = Range(Cells(1, "E"), Cells(lastrow, "E")).SpecialCells(xlCellTypeConstants)
 'Sheet1.Columns("D:Z").ColumnWidth = 21

For i = 1 To rng.Areas.count
        Sheet2.Cells(i + 42, "D").Resize(1, rng.Areas(i).count).Value = Application.WorksheetFunction.Transpose(rng.Areas(i))
        'Sheet2.Cells(i + 45, "W").Resize(1, rng.Areas(i).Count).Value = Application.WorksheetFunction.Transpose(rng.Areas(i))
Next i
Set rng = Nothing
End Sub
Public Sub coltorow4()
Dim rng As Range
Dim i As Long
Dim lastrow As Long
lastrow = Cells(Rows.count, 1).End(xlUp).Row
Set rng = Range(Cells(1, "F"), Cells(lastrow, "F")).SpecialCells(xlCellTypeConstants)
 'Sheet1.Columns("D:Z").ColumnWidth = 21

For i = 1 To rng.Areas.count
        Sheet2.Cells(i + 43, "D").Resize(1, rng.Areas(i).count).Value = Application.WorksheetFunction.Transpose(rng.Areas(i))
        'Sheet2.Cells(i + 45, "W").Resize(1, rng.Areas(i).Count).Value = Application.WorksheetFunction.Transpose(rng.Areas(i))
Next i

End Sub

----------------- ++ ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ --------------------

-----------------+++++++++++++--------------
Requiered Output pattern:
-------------------------

	Stone Specification																																																																		
	1	Stone Name & Colour										White Diamond										White Diamond										White Diamond																				 															
	2	Type  										Single cut										Single cut										Single cut																				 															
	3	Country of Origin										India										India										India																				 															
	4	Shape										Round										Round										Round																				 											
	5	Stone Dimensions (L x W)										1.15mm										1.1mm										1.15 x 1.20mm																				 											
	6	Diamond Grade										H/I1										H/I1										H/I1																				 											
	7	Non Permanent or Special Care Stone Treatment																																																		 											
	8	Carat Weight										0.0066ct										0.0056ct										0.0074ct																				 											
	9	Quantity										30										44										40																				 											
	10	Total Carat Weight										0.21ct										0.25ct										0.31ct																				 											
	11	Grand Total Carat Weight										0.75ct																																																			


Current output:
---------------
	Stone Specification														
	1	Stone Name & Colour	WHITE DIAMOND												
	2	Type	WHITE DIAMOND	WHITE DIAMOND											
	3	Country of Origin	ROUND	ROUND	ROUND	ROUND	ROUND	ROUND	India	India					
	4	Shape	WHITE DIAMOND												
	5	Stone Dimensions (L X W)	ROUND	ROUND											
	6	Diamond Grade	WHITE DIAMOND	WHITE DIAMOND	0.004ct										
	7	Non Permanent or Special Care Stone Treatment	ROUND	ROUND	ROUND	ROUND	ROUND	ROUND							
	8	Carat Weight	WHITE DIAMOND												
	9	Quantity	WHITE DIAMOND	ROUND											
	10	Total Carat Weight	WHITE DIAMOND	ROUND	0.004ct										

推荐答案

如果没有能够看到您的数据，这个解决方案就是一个很好的起点。

Without being able to see your data this solution is a good starting point.

Public Sub coltorow()
Dim rng As Range
Dim i As Long, newSheetRow As Long
Dim rngValues()
Dim lastrow As Long

''Variable to keep track of row on new sheet
newSheetRow = 1

''Determine last row of data on datasheet
lastrow = Cells(Rows.Count, 1).End(xlUp).Row

Set rng = Range(Cells(1, "A"), Cells(lastrow, "A")).SpecialCells(xlCellTypeConstants)

''Populate Array with Column values
rngValues = rng.Value2

''Activate new Sheet
Sheet2.Activate

''Transpose values to Row on new sheet
For i = LBound(rngValues) To UBound(rngValues) Step 1
    Sheet2.Cells(newSheetRow, i) = rngValues(i, 1)
Next

End Sub

另外，鉴于您上面的格式（每列不同的程序）我会声明这个程序的一个版本n要在现有工作表和新工作表的当前行上复制的列的参数，并为您需要处理的每个列递归调用它。

Also, given the format that you have above (different procedures for each column) I would declare a version of this procedure that took an argument of the column to copy on the existing sheet and the current row of the new sheet and call it recursively for each column that you need to process.

这篇关于宏中用于将行转换为列的问题的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！