Sub 導(dǎo)出()Dim Sht As Worksheet, ShtName As StringDim NextRow As Long, NextRow2 As LongDim iRow As Long, Index As LongDim mySum As DoubleiRow = 2Sheets("地塊表").ActivateDo While Cells(iRow, "F").Value <> ""ShtName = Cells(iRow, "F").ValueSet Sht = Sheets(ShtName)NextRow = Sht.Range("C65536").End(xlUp).Row + 1If NextRow = 3 ThenmySum = 0Index = 0End IfIndex = Index + 1If Index <= 39 ThenSht.Cells(NextRow, "A").Value = Cells(iRow, "A").Value '序號(hào)Sht.Cells(NextRow, "C").Value = Cells(iRow, "B").Value '農(nóng)戶代表Sht.Cells(NextRow, "G").Value = Cells(iRow, "C").Value '地塊數(shù)Sht.Cells(NextRow, "K").Value = Cells(iRow, "D").Value '承包面積ElseNextRow2 = Sht.Range("O65536").End(xlUp).Row + 1Sht.Cells(NextRow2, "O").Value = Cells(iRow, "A").Value '序號(hào)Sht.Cells(NextRow2, "Q").Value = Cells(iRow, "B").Value '農(nóng)戶代表Sht.Cells(NextRow2, "U").Value = Cells(iRow, "C").Value '地塊數(shù)Sht.Cells(NextRow2, "Y").Value = Cells(iRow, "D").Value '承包面積End IfmySum = mySum + Cells(iRow, "D").Value '累計(jì)承包面積Sht.Range("Q42").Value = mySumiRow = iRow + 1ShtName = Cells(iRow, "F").ValueLoopMsgBox ("ok") End Sub

　　

轉(zhuǎn)載于:https://www.cnblogs.com/nextseven/p/7248510.html

總結(jié)

以上是生活随笔為你收集整理的20170728xlVBA改转置一例的全部內(nèi)容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網(wǎng)站內(nèi)容還不錯(cuò)，歡迎將生活随笔推薦給好友。