blocks|key|3959430|text|这会帮你搞定的..。|type|unstyled|depth|inlineStyleRanges|entityRanges|data|3959431|Public+Sub+TransformData()
++++Dim+lngRow+As+Long,+lngEndRow+As+Long,+objSrcSheet+As+Worksheet,+objDestSheet+As+Worksheet
++++Dim+strLetter+As+String,+strNumber+As+String,+lngCol+As+Long,+lngWriteRow+As+Long

++++Set+objSrcSheet+=+Sheet1
++++Set+objDestSheet+=+Sheet2

++++lngEndRow+=+objSrcSheet.Range("A"+&+objSrcSheet.Rows.Count).End(xlUp).Row

++++With+objSrcSheet
++++++++For+lngRow+=+1+To+lngEndRow
++++++++++++strLetter+=+.Cells(lngRow,+1)

++++++++++++If+strLetter+<>+""+Then
++++++++++++++++For+lngCol+=+2+To+.Columns.Count
++++++++++++++++++++strNumber+=+.Cells(lngRow,+lngCol)

++++++++++++++++++++If+strNumber+=+""+Then+Exit+For

++++++++++++++++++++lngWriteRow+=+lngWriteRow+%2B+1

++++++++++++++++++++objDestSheet.Cells(lngWriteRow,+1)+=+strLetter
++++++++++++++++++++objDestSheet.Cells(lngWriteRow,+2)+=+strNumber
++++++++++++++++Next
++++++++++++End+If
++++++++Next
++++End+With
End+Sub|code-block|syntax|javascript|3959432|..。我决定给你一个完整的解决方案。无论是对还是错，是最好的还是最坏的，这就是我要做的，鉴于你正在学习，我希望它能对你有所帮助。它还采用了一种不使用SELECT的方法，这只会减慢您的速度，并且被认为是非常糟糕的做法。|3959433|它假设我的源工作表如下图所示。我希望这能有所帮助。|3959434|​|3959435|📷|atomic|offset|length|3959436|3959437|entityMap|0|IMAGE|mutability|IMMUTABLE|imageUrl|https://ask.qcloudimg.com/http-save/yehe-900000/b62d1e4e766e2d12d8982ce049982325.png|imageAlt^0|0|0|0|0|0|0|1|0|0|0^^$0|@$1|2|3|4|5|6|7|11|8|@]|9|@]|A|$]]|$1|B|3|C|5|D|7|12|8|@]|9|@]|A|$E|F]]|$1|G|3|H|5|6|7|13|8|@]|9|@]|A|$]]|$1|I|3|J|5|6|7|14|8|@]|9|@]|A|$]]|$1|K|3|L|5|6|7|15|8|@]|9|@]|A|$]]|$1|M|3|N|5|O|7|16|8|@]|9|@$P|17|Q|18|1|19]]|A|$]]|$1|R|3|L|5|6|7|1A|8|@]|9|@]|A|$]]|$1|S|3|-4|5|6|7|1B|8|@]|9|@]|A|$]]]|T|$U|$5|V|W|X|A|$Y|Z|10|-4]]]]

This will do it for you ...

<pre><code>Public Sub TransformData()
 Dim lngRow As Long, lngEndRow As Long, objSrcSheet As Worksheet, objDestSheet As Worksheet
 Dim strLetter As String, strNumber As String, lngCol As Long, lngWriteRow As Long

 Set objSrcSheet = Sheet1
 Set objDestSheet = Sheet2

 lngEndRow = objSrcSheet.Range("A" &amp; objSrcSheet.Rows.Count).End(xlUp).Row

 With objSrcSheet
 For lngRow = 1 To lngEndRow
 strLetter = .Cells(lngRow, 1)

 If strLetter &lt;&gt; "" Then
 For lngCol = 2 To .Columns.Count
 strNumber = .Cells(lngRow, lngCol)

 If strNumber = "" Then Exit For

 lngWriteRow = lngWriteRow + 1

 objDestSheet.Cells(lngWriteRow, 1) = strLetter
 objDestSheet.Cells(lngWriteRow, 2) = strNumber
 Next
 End If
 Next
 End With
End Sub
</code></pre>

... I decided to give you an entire solution. Right or wrong, best or worst, that's how I would do it and given you're learning, I hope it helps you. It also takes an approach where SELECT is not being used, that will do nothing more than slow you down and is considered to be extremely bad practice.

It assumes my source worksheet looks like the below image. I hope that helps.

<a href="https://i.stack.imgur.com/ASW25.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/ASW25.png" alt="enter image description here"></a>

blocks|key|3959478|text|在数组中工作可能更容易导航(当然也更快)。|type|unstyled|depth|inlineStyleRanges|entityRanges|data|3959479|Option+Explicit

Sub+stackTranspose()

++++Dim+i+As+Long,+j+As+Long,+k+As+Long,+vals+As+Variant,+arr+As+Variant

++++'collect+original+values+into+source+array
++++With+Worksheets(1)
++++++++vals+=+.Cells(1,+"A").CurrentRegion.Value2
++++End+With

++++'redimension+target+array+and+set+k+for+first+'row'
++++ReDim+arr(1+To+Application.Count(vals),+1+To+2)
++++k+=+1

++++'loop+through+source+and+transfer+transposed+values
++++For+i+=+LBound(vals,+1)+To+UBound(vals,+1)
++++++++For+j+=+LBound(vals,+2)+%2B+1+To+UBound(vals,+2)
++++++++++++'is+there+a+value+to+transfer?
++++++++++++If+vals(i,+j)+<>+vbNullString+Then
++++++++++++++++arr(k,+1)+=+vals(i,+LBound(vals,+2))
++++++++++++++++arr(k,+2)+=+vals(i,+j)
++++++++++++++++'increment+target+'row'
++++++++++++++++k+=+k+%2B+1
++++++++++++Else
++++++++++++++++'blank+value;+move+to+next+source+'row'
++++++++++++++++Exit+For
++++++++++++End+If
++++++++Next+j
++++Next+i

++++'put+target+values+into+Sheeet2
++++With+Worksheets(2)
++++++++.Cells(1,+"A").Resize(UBound(arr,+1),+UBound(arr,+2))+=+arr
++++End+With

End+Sub|code-block|syntax|javascript|3959480|entityMap^0|0|0^^$0|@$1|2|3|4|5|6|7|I|8|@]|9|@]|A|$]]|$1|B|3|C|5|D|7|J|8|@]|9|@]|A|$E|F]]|$1|G|3|-4|5|6|7|K|8|@]|9|@]|A|$]]]|H|$]]

It may be easier to navigate (and certainly faster) to work within arrays.

<pre><code>Option Explicit

Sub stackTranspose()

 Dim i As Long, j As Long, k As Long, vals As Variant, arr As Variant

 'collect original values into source array
 With Worksheets(1)
 vals = .Cells(1, "A").CurrentRegion.Value2
 End With

 'redimension target array and set k for first 'row'
 ReDim arr(1 To Application.Count(vals), 1 To 2)
 k = 1

 'loop through source and transfer transposed values
 For i = LBound(vals, 1) To UBound(vals, 1)
 For j = LBound(vals, 2) + 1 To UBound(vals, 2)
 'is there a value to transfer?
 If vals(i, j) &lt;&gt; vbNullString Then
 arr(k, 1) = vals(i, LBound(vals, 2))
 arr(k, 2) = vals(i, j)
 'increment target 'row'
 k = k + 1
 Else
 'blank value; move to next source 'row'
 Exit For
 End If
 Next j
 Next i

 'put target values into Sheeet2
 With Worksheets(2)
 .Cells(1, "A").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
 End With

End Sub
</code></pre>

Today I finished the loops section of by VBA course and have been doing a few practices, but I've come across a problem I cannot seem to figure out.

I want to transpose data from sheet 1 to sheet to sheet 2. 

Sheet 1

<pre><code>a 1 2 3
b 1 2 3 4 5 6
c 1 2 3 4
</code></pre>

I am trying to write a macro which will transpose the data into Sheet 2 like this:

<pre><code>a 1
a 2
a 3
b 1
b 2
b 3
b 4
b 5
b 6
c 1
c 2
c 3
c 4
</code></pre>

I tried to write some VBA code, but I have no idea how to approach this particular problem. I tried using Do Until Loops, but the issue I run into is how I get the the letters in sheet 1, column 1 to paste with their corresponding numbers in sheet 2.

A friend did some code for me to analyse, but it confused me even more. It works for this data set, but fails to do this with a larger data set (one where the letters go up to 'z').

Here is his code:

<pre><code>Sub transpose()
 Sheets(1).Select

 lrow1 = Cells(Rows.Count, 1).End(xlUp).Row

 For i = 1 To lrow1
 nums = 2

 Cells(i, nums).Select

 Do Until IsEmpty(ActiveCell)
 nums = nums + 1
 Cells(i, nums).Select
 Loop

 Range(Cells(i, 2), Cells(i, nums)).Copy
 Sheets(2).Select

 lrow2 = Cells(Rows.Count, 2).End(xlUp).Row

 Cells(lrow2 + 1, 2).Select

 Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
 False, transpose:=True

 Sheets(1).Select

 Cells(i, 1).Copy

 Sheets(2).Select

 Cells(lrow2 + 1, 1).Select

 Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
 False, transpose:=False

 lrow3 = Cells(Rows.Count, 2).End(xlUp).Row

 Cells(lrow2 + 1, 1).Select

 Selection.AutoFill Destination:=Range(Cells(lrow2 + 1, 1), Cells(lrow3, 1)), Type:=xlFillDefault

 Sheets(1).Select
 Next i

 Sheets(2).Select

 Rows("1:1").Select

 Selection.Delete Shift:=xlUp
End Sub
</code></pre>

<a href="https://pastebin.com/J45fmYKj" rel="nofollow noreferrer">https://pastebin.com/J45fmYKj</a>

Transposing In Particular Format

翻译质量差，导致语言生硬或混乱。

没有提供实际的解决方法或示例。

解答不清晰，无法理解或解决问题。

页面排版不美观，阅读体验差。

文章

问答

视频

学习中心

腾讯云实验室

直播

竞赛

腾讯云架构师技术同盟交流圈

腾讯云数据库专区

腾讯云顾问专区

腾讯云原生专区

腾讯混元专区

腾讯云TCE专区

腾讯云Lighthouse专区

腾讯云HAI专区

腾讯云Edgeone专区

腾讯云存储专区

腾讯云智能专区

腾讯轻联专区 

腾讯云开发专区

TAPD专区

腾讯轻量云游戏服专区

腾讯云最具价值专家

腾讯云架构师技术同盟

腾讯云创作之星

腾讯云开发者先锋 

腾讯云代码助手

CODING DevOps

Cloud Studio

SDK中心

API中心

命令行工具

今天我完成了by VBA课程的循环部分，并做了一些练习，但我遇到了一个我似乎无法解决的问题。我想将数据从工作表1转到工作表2。图1a   1   2   3b   1   2   3   4   5   6c   1   2   3   4我正在尝试编写一个宏来将数据转置到工作表2中，如下所示：a   1a   2a ...

问特殊格式的转置
EN

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问特殊格式的转置EN

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问特殊格式的转置
EN