匹配可用内容后，将行转换为列

问题描述

类似于这篇文章，但有一点不同： here来自@RetiredGeek的输入 希望这是有道理的； 我需要一些帮助来解决问题。这是问题： 我从网络上以多个表，两列和60行的形式获取了一些数据。 一列包含一些标题，行包含数据。但是，代表标题的第一列上的值每天都在变化，并且它们并不相同。行上的数据也会相应更改。我想将某些标题从第一列复制到另一张纸上，并动态地提取相应的行值。在下面，我有三列标题的3个示例，它们是给定日期标题的可能性。在给定的一天一个标头。我希望代码可以针对这三列进行检查，以匹配与三列之一匹配的已下载数据中的可用内容。然后复制匹配的列并将其转置在另一张纸上，然后复制匹配的数据（现在为行）并将其转置为下一行：

Sub CopyandTranspose（）

 Dim wksSht1 As Worksheet
   Dim wksSht2 As Worksheet
   Dim wksSht4 As Worksheet
   Dim rngHdr  As Range
   Dim lMatch  As Long


Dim lColCnt As Long
   Dim lrow2 As Long
   Set wksSht1 = Worksheets("Sheet1")
   Set wksSht2 = Worksheets("Sheet2")
   Set wksSht4 = Worksheets("Sheet4")

' wksSht2.Activate
Set rngHdr = Nothing


   lColCnt = 1
  ' Lrow = 2

 'Set rngHdr = wksSht2.Cells(1,lColCnt)
 Set rngHdr = ActiveSheet.Cells(1,lColCnt)
   
   
   Do
   On Error Resume Next
     lMatch = Application.Match(rngHdr.value,wksSht1.Columns(1),0)
    
     Range(wksSht1.Cells(lMatch,1),wksSht1.Cells(lMatch,1).Offset(0,1)).Copy
  
     rngHdr.PasteSpecial Paste:=xlPasteAll,Operation:=xlNone,_
                         SkipBlanks:=False,Transpose:=True
'*** Move to next Header column ***
     lColCnt = lColCnt + 1
 'Set rngHdr = wksSht2.Cells(1,lColCnt)
       ' Application.Wait Now + TimeValue("00:00:01")
    Loop While rngHdr <> ""
END sub

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）