セルデータを別のセルからのハイパーリンクで照合/置換する

Question

私は多くの手動作業を行っていますが、関連するマクロを見つけようとしましたが、残念ながら見つからなかった。

基本的に、私のExcelシートには4つの列（A、B、C、D）があります。私は、今月の会社の提出書類に多くの審査をした後、列AとBにデータを残しています（私の範囲を上回る、下回る特定のマークキャップを削除し、私の部門以外のデータは削除します）。

• Aは、会社名（大文字、小文字、時には組み合わせ）

• 列Bは、日付（私は今、月単位でやっている）これら一度

を持っている列2つの列が用意されています。ウェブサイトからWebクエリを実行します。このクエリは、ハイパーリンクを使用して月間のファイルをSECでダウンロードします。

• 列Cは、ハイパーリンク付き会社名（コルAのように書式設定は必ずしも同じではない場合）Dは、日付（つまり、同じ月になりますので、私は、毎月ダウンロードしています）を持っている

• 列を持っています

カラムCのデータは、Col Aよりはるかに大きい。それには不要な企業のハイパーリンクも含まれており、そのウェブサイトでの検索が現在の範囲よりもカスタマイズできる方法はありません。

コルDがあるため、より申告

などの、はるかに長いコルBより：

Col A Col B  Col C   Col D 
        (Hyperlinks) 
Abc  3/1/2008  AAA   3/1/2008 
BCD  3/1/2008  AAB   3/1/2008 
BCD  3/2/2008  AAC   3/1/2008 
cDE  3/2/2008  ABC   3/1/2008 
DeF  3/3/2008  ABE   3/1/2008 
        BCD   3/1/2008 
        ABC   3/2/2008 
        BCD   3/2/2008 
        CDE   3/2/2008 
        AAA   3/3/2008 
        AAF   3/3/2008 
        DEF   3/3/2008 

私はそのハイパーリンクとコルAを置き換えるためにコルCで会社を必要とする、彼らは上で提供されます同じ日付（Col B = Col D）。大文字と小文字は区別されません（会社名は一意です）。

Col Cの不要な企業データのために、これらの列に「AZ」を並べ替えても、Col AとCの会社の順序は同じではありません。CはAよりもはるかに長い列です。

毎月1200から1500件のファイルがあり、私は手動でチェックしていて、手動で日付別に置き換えています。私は3年間これをしなければなりません、私は過去10日間同じ月にいます。さらに多くのことがあります：私は各ファイリングを開き、備考欄を読んで更新する必要があります。

Answer 1

以下のコードは、あなたが求めるものであると信じています。

私はあなたのイメージに合うように、このワークシートを作成：

以下のマクロは、ワークシートを変更します。

列C及びDは、内のすべての値があるため、今redundentですそれらの列は列FとGに移動されました。

編集

ミーナは彼女のデータに対してマクロを実行しましたが、それは一致している必要がありますすべての値と一致しませんでした。彼女は自分のデータのコピーを私に電子メールで送りました。彼女のデータを調べたところ、私は以下のマクロに3つの変更を加えました：

• ミーナのワークシートには見出し行がありません。私は最初のデータ行を指定する定数を使用します。値を2から1に変更しました。
• 多くの参照値には末尾にスペースがあります。 TRIM（）を使用して、比較の前に後続のスペースを削除しました。
• マクロは2つの新しいデータ列を作成します。これらはデフォルトの幅のままにしておいたので、値が長い場合は折り返して複数の行が必要になります。私は今、列の幅をコピー元の列からコピー先の列にコピーするコードを追加しました。

。

Option Explicit 
    ' If the columns have to be moved, update these constants 
    ' and the code will change to match. 
    Const ColRefCompany As Long = 1 
    Const ColRefDate As Long = 2 
    Const ColWebCompany As Long = 3 
    Const ColWebDate As Long = 4 
    Const ColSaveCompany As Long = 6 
    Const ColSaveDate As Long = 7 
    Const ColLastLoad As Long = 4 
    Const RowDataFirst As Long = 1  ' No header row 
Sub CopyWebValuestoSaveColumns() 

    Dim CellValue() As Variant 
    Dim ColCrnt As Long 
    Dim Rng As Range 
    Dim RowRefCrnt As Long 
    Dim RowSave() As Long 
    Dim RowSaveCrnt As Long 
    Dim RowWebCrnt As Long 
    Dim RowLast As Long 

    ' Find the last cell with a value 
    With Worksheets("Sheet1") 
    Set Rng = .Cells.Find(What:="*", After:=.Range("A1"), LookIn:=xlFormulas, _ 
          LookAt:=xlWhole, SearchOrder:=xlByRows, _ 
          SearchDirection:=xlPrevious) 

    If Rng Is Nothing Then 
    Call MsgBox("Sheet is empty", vbOKOnly) 
    Exit Sub 
    End If 
    RowLast = Rng.Row 
    ' Load all reference and web values to CellValue. Searching an array 
    ' is faster than searching the worksheet and hyperlinks are converted 
    ' to their display values which gives an easier comparison. 
    ' Note for arrays loaded from a worksheet, dimension one is for rows 
    ' and dimension two is for columns. 
    CellValue = .Range(.Cells(1, 1), .Cells(RowLast, ColLastLoad)).Value 

    ' RowSave() will record the position in the save columns of the values 
    ' in the web columns. Allow for one entry per row in web list. 
    ReDim RowSave(1 To RowLast) 

    RowRefCrnt = RowDataFirst 

    ' Set web company names to lower case and remove leading and trailing 
    ' spaces ready for matching 
    For RowWebCrnt = RowDataFirst To RowLast 
    CellValue(RowWebCrnt, ColWebCompany) = _ 
           Trim(LCase(CellValue(RowWebCrnt, ColWebCompany))) 
    Next 

    Do While True 
    If CellValue(RowRefCrnt, ColRefCompany) = "" Then 
     ' Empty cell in reference company column. Assume end of list 
     Exit Do 
    End If 
    ' This loop makes no assumptions about the sequence of the 
    ' Reference and Web lists. If you know their sequences match or 
    ' if you can sort the two pairs of columns, this loop could be 
    ' made faster 
    ' Set reference company name to lcase and remove leading and trailing 
    ' spaces ready for matching 
    CellValue(RowRefCrnt, ColRefCompany) = _ 
           Trim(LCase(CellValue(RowRefCrnt, ColRefCompany))) 

    For RowWebCrnt = RowDataFirst To RowLast 
     If CellValue(RowRefCrnt, ColRefCompany) = _ 
             CellValue(RowWebCrnt, ColWebCompany) And _ 
      CellValue(RowRefCrnt, ColRefDate) = _ 
              CellValue(RowWebCrnt, ColWebDate) Then 
     ' Reference and web values match. 
     ' Record that the web values from row RowWebCrnt 
     ' are to be copied to row RowRefCrnt 
     RowSave(RowWebCrnt) = RowRefCrnt 
     Exit For 
     End If 
    Next 
    RowRefCrnt = RowRefCrnt + 1 
    Loop 
    RowSaveCrnt = RowRefCrnt  ' First row in save column that is available 
           ' for unused web values 
    For RowWebCrnt = RowDataFirst To RowLast 
    If RowSave(RowWebCrnt) = 0 Then 
     ' The web values on this row has not been matched to reference values. 
     ' Record these web values are to be moved to the next available row 
     ' in the save columns 
     RowSave(RowWebCrnt) = RowSaveCrnt 
     RowSaveCrnt = RowSaveCrnt + 1 
    End If 
    Next 

    .Columns(ColSaveCompany).ColumnWidth = .Columns(ColWebCompany).ColumnWidth 
    .Columns(ColSaveDate).ColumnWidth = .Columns(ColWebDate).ColumnWidth 

    ' Copy values from web columns to save columns 
    For RowWebCrnt = RowDataFirst To RowLast 
    .Range(.Cells(RowWebCrnt, ColWebCompany), _ 
      .Cells(RowWebCrnt, ColWebDate)).Copy _ 
         Destination:=.Cells(RowSave(RowWebCrnt), ColSaveCompany) 
    Next 

    End With 

End Sub