ここから本文です

A列とB列を比べて違う場合はA列の文字列をコピペしたい。

pbu********さん

2017/10/1513:37:56

A列とB列を比べて違う場合はA列の文字列をコピペしたい。

チェンジイベントマクロで12151行目以降からA列が入力済みで新たに同じ行のB列にコピペした場合にA列とB列の内容が異なる場合には、A列の内容をAI列にコピペしたいのです。
A列の文字列はカタカナのみで「・」の点が一つ以上あった場合のみ適用します。
もし平仮名や漢字が一文字でも含む場合やカタカナだけでも「・」が無ければそのまま何も動作しないでください。
AI列には=B列の内容が転写されるように数式が入っています。

クリップボード内容「タチ・ツテト」をB12155にコピペしたとしまして
下のマクロ記録のような感じです

Sub Macro1()
'
' Macro1 Macro
'

'
Range("B12155").Select
ActiveSheet.PasteSpecial Format:="Unicode テキスト", Link:=False, _
DisplayAsIcon:=False, NoHTMLFormatting:=True
Range("A12155").Select
Selection.Copy
Range("AI12155").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub

補足あっすいません。
すでに作成を開始されてましたら申し訳ございません
カタカナのみで「=」この記号も含む場合も追加してください
アイ=ウエ=オ
アイ・ウエ=オ
などです

Macro1 Macro,Sub Macro1,Selection.Copy,DisplayAsIcon,AI12155&quot,echC.Row,prmStr

閲覧数:
42
回答数:
1
お礼:
500枚

違反報告

ベストアンサーに選ばれた回答

jiy********さん

2017/10/1615:55:24

チェンジイベントで、と書かれていますが、ご提示されているコードはイベントプロシージャではないですね。そこのところの意味が分からないので、ご提示のコードには関係なく、ご質問内容を見てWorksheet_Changeのコードを書きました。

クリップボードの内容がどのようなものか不明です。Shift_JISしか考慮せずに作っていますので、ご希望の通りではないかも知れません。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim echC As Range
Dim tgtR As Range

On Error Resume Next
Set tgtR = Application.Intersect(Target, Range("B12151:B" & Rows.Count))
On Error GoTo 0
If tgtR Is Nothing Then
Exit Sub
End If
If tgtR.CountLarge > 1000 Then
If MsgBox(tgtR.CountLarge & "個のセルの変更チェックを行います。" _
& "時間がかかる可能性がありますが、実行しますか?" _
, vbOKCancel + vbExclamation + vbDefaultButton2) = vbCancel Then
Exit Sub
End If
End If

For Each echC In tgtR
Cells(echC.Row, "AI").Value = echC.Value
If Cells(echC.Row, "A").Value <> echC.Value Then
If chk_katakana_and_symbol(Cells(echC.Row, "A")) = True Then
Cells(echC.Row, "AI").Value = Cells(echC.Row, "A").Value
End If
End If
Next echC
End Sub

Private Function chk_katakana_and_symbol(prmStr As String)
Dim i As Long
Dim s As String

chk_katakana_and_symbol = False
If InStr(prmStr, "・") + InStr(prmStr, "=") = 0 Then
Exit Function
End If

For i = 1 To Len(prmStr)
s = Mid(prmStr, i, 1)
If s <> "・" And s <> "=" Then
If s Like "[ァ-ヶ]" Or s = "ー" Or s Like "[ヲ-゚]" Then
Else
Exit Function
End If
End If
Next i
chk_katakana_and_symbol = True
End Function

"・"は全角、"="は半角としてあります。違えば適宜ご修正ください。

ご質問の内容と似たものを以前見たことがありますが、別IDでご質問されたことがありますでしょうか。もし同じ方であれば、前回の質問のリンクも貼り付けてくださると、回答する側も何をやろうとしているのか予測できて回答が付きやすいかと思います。

  • 質問者

    pbu********さん

    2017/10/1616:38:58

    どうもありがとうございます。
    まったくこの通りで動作OKです。
    このマクロの凄いところがB列に一旦コピペした時
    何らかのコピペ違い(一文字落としたとか)でクリアしてもAI列の数式が生きてましてリピートが効くということでした。
    まさしく当方の趣旨にピッタリ合致しました。

    別IDの件はちょくちょく変えて質問することがあります。
    類似した質問はあると記憶しておりますが
    このマクロの使用目的に関してはないと思います。
    但しマクロ作成は、この同一ブックに関しての質問だらけです。
    今度はIDを変えても管理しておいて、すぐリンクを張れるように致したいと思います。

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

質問した人からのコメント

2017/10/16 16:41:47

この度のご回答誠にありがとうございました。
しばらく最初のご回答までの期間が掛かりましたが
達人中の更に上をいく方がおられたのには驚かされます。

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる