[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『CEの頭文字』（CE）
お世話になります。 C列E列の頭文字（数字アルファベット等）の相違を検索したいのですが 条件・頭文字５文字以内が同じならＧ列に１を立てる
例） C1・・・AB12-CD3400←頭はＡ〜始まり５文字目は- D1・・・AB12-CD34000←頭はＡ〜始まり５文字目は- G1・・・1←（重複と言う意味） 6文字目からはバラバラでもＯＫなので・・・・ データは数万とあります。 よろしくお願いいたします。(CE)
left関数で
？どう言うことでしょうか？初心者な者で(CE)
もしかしたら勘違いかもしれません。 5文字目までが完全に一致したものだけをＧに１をたてたいのですが？？ マクロは無理でしょうか？？(CE)
> C列E列の頭文字（数字アルファベット等）の相違を検索したいのですが > 条件・頭文字５文字以内が同じならＧ列に１を立てる
数式なら [G1]に
=IF(LEFT(C1,5)=LEFT(E1,5),1,"")
必要な行までコピー
ということだと思うので、
> マクロは無理でしょうか？？(CE) なら、とりあえず、この操作をマクロ記録してみれば、と思います.
(kanabun)
ありがとうございます。 初めて行ったのですが下記のようになってダメでした・・
Sub Macro1() ' ' Macro1 Macro '
'
Range("G1").Select
ActiveCell.FormulaR1C1 = "=IF(LEFT(RC[-4],5)=LEFT(RC[-2],5),1,"""")"
Range("G2").Select
End Sub
難しすぎて・・(CE)
こちらで記録したマクロは↓でした。
Sub Macro1()
' Macro1 Macro
'
Range("G1:G40").Select
Selection.FormulaR1C1 = "=IF(LEFT(RC[-4],5)=LEFT(RC[-2],5),1,"""")"
End Sub
つまり CEさんのと違うのは
最初に数式を書き込む範囲を [G1:G40]のデータがある行全部を
指定している点です。
G1からG列の何行目まで数式を書き込むかを C列か E列で最終行番号
を求めておいて、数式をセットする範囲のマクロ記録
' Range("G1:G40") の代わりに
Range("G1:G" & データ最終行) とすればいいです。
数式は R1C1形式で記録されるから、どの行もこのままでいいですよね。
Sub CE同じなら_G列に1を()
Dim LastRow As Long '↓ E列で データ最終行を求めています
LastRow = Range("E65536").End(xlUp).Row
Range("G1:G" & LastRow).FormulaR1C1 = "=IF(LEFT(RC[-4],5)=LEFT(RC[-2],5),1,"""")"
End Sub
補足 マクロ記録は R1C1 形式で数式記録されますが、 手作業で打ち込んだときのような A1形式でも同じです。
Range("G1:G" & LastRow).Formula = "IF(LEFT(C1,5)=LEFT(E1,5),1,"""")"
(kanabun)
kanabunさん大変！！ 式の最初の「=」が抜けてますよ。 （まぁ、気付いて修正出来る範囲内かとは思いますが・・・。）
(HANA)
> kanabunさん大変！！ > 式の最初の「=」が抜けてますよ。 >（まぁ、気付いて修正出来る範囲内かとは思いますが・・・。）
おぉ、抜けてました。ごめんなさい。 HANA さん、フォローありがとうございます。 数式の お尻の """")" の数ばかり数えてました (kanabun) m(__)m
ありがとうございます。
一つぬけていました。
ＣＥが入力されない場合も１が・・・
入力があり 5文字目までが完全に一致したものだけをＧに１をたてたいのですが・
Sub Macro1()
' Macro1 Macro
'
Range("G1:G20000").Select
Selection.FormulaR1C1 = "=IF(LEFT(RC[-4],5)=LEFT(RC[-2],5),1,"""")"
End Sub
範囲は変更しました。(CE)
空白"","",を何処かにいれれば・・・
数式はこんな感じ？ "=IF(and(counta(c1,e1)=2,LEFT(C1,5)=LEFT(E1,5)),1,"""")" (seiya)
マクロの数式？を変更したら#NAMEがでてしまいました。
Sub Macro1()
' Macro1 Macro
'
Range("G1:G20000").Select
Selection.FormulaR1C1 = "=IF(and(counta(c1,e1)=2,LEFT(C1,5)=LEFT
(E1,5)),1,"""")"
End Sub と入れてみたのですが？(CE)
A1形式の数式なのでFormulaR1C1 にするとそうなるでしょうね...
Selection.Formula = "=IF(and(counta(c1,e1)=2,exact(LEFT(C1,5)=LEFT(E1,5))),1,"""")"
(完全一致)
(seiya)
ありがとうございます。
しかし実行エラー1004が
Sub Macro1()
' Macro1 Macro
'
Range("G1:G20000").Select
Selection.Formula = "=IF(and(counta(c1,e1)=2,exact(LEFT(C1,5)=LEFT
(E1,5))),1,"""")"
End Sub に変更したのですが？(CD)
あらら = を , に変えてください。
"=IF(and(counta(c1,e1)=2,exact(LEFT(C1,5),LEFT(E1,5))),1,"""")"
^^^
(seiya)
何度も申し訳ございません。
Sub Macro1()
' Macro1 Macro
'
Range("G1:G20000").Select
Selection.FormulaR1C1 = "=IF(and(counta(c1,e1)=2,exact(LEFT(C1,5),LEFT
(E1,5))),1,"""")"
End Sub
上記のように標準モジュールにいれて実行すると#NAME？とでてしまい？
#NAME?のところをクリックして式をみると
=IF(AND(COUNTA($A:$A,'e1')=2,EXACT(LEFT($A:$A,5),LEFT('e1',5))),1,"")
になってしまいＡ列を指して？？(CD)
FormulaR1C1 プロパティはxlA1形式の数式は受け付けません。 Formula です。
Range("G1:G20000").Formula = "=IF(and(counta(c1,e1)=2,exact(LEFT(C1,5),LEFT(E1,5))),1,"""")"
^^^^^^^^
です。
(seiya)
Sub Macro1()
' Macro1 Macro
'
Range("G1:G20000").Formula = "=IF(and(counta(c1,e1)=2,exact(LEFT(C1,5),LEFT(E1,5))),1,"""")"
End Sub で出来ました。。ありがとうございました。(CE)
今後も色々なデーターに対応出来ればいいな〜と思い駄目もとで質問させて いただきます。 たとえば、マクロを実行すると メッセージボックスが出てきて・複数の検索可能 1:何処の列を検索しますか？ 2:何文字目（数字、英字、その他も含む）までの文字の重複を検索？ 3:その答えを（今回は行が多いい事を想定して）Ｚ列に 上記2番目の指定文字数が重複していれば”重複” していなければ"相違"と言う文字を・・・ なんて事は夢？夢？でしょうか？(CE)
夢マクロはどっちでっしゃろ？
（弥太郎）
'------------------------
Sub 夢マクロ()
Dim mxrow As Long, rng As String, idx As Integer, adrs1 As String, adrs2 As String, x
rng = InputBox("範囲は何処と何処でっか？ A=B,E=F,H=I といった塩梅に書き込んでくらはい。")
If rng = "" Then Exit Sub
idx = StrConv(InputBox("何文字目（数字、英字、その他も含む）まで文字の重複検索？"), vbNarrow)
If idx = 0 Then MsgBox "キチンと入力してくらはい": Exit Sub
If Not rng Like "*,*" Then
Range("z1").Resize(Range(Split(rng, "=")(0) & Rows.Count).End(xlUp).Row). _
Formula = "=if(and(counta(" & Split(rng, "=")(0) & 1 & "," _
& Split(rng, "=")(1) & 1 & "),exact(left(" & Split(rng, "=")(0) _
& 1 & "," & idx & "),left(" & Split(rng, "=")(1) & 1 & "," _
& idx & "))),""重複"",""相違"")"
Exit Sub
Else
data = Split(rng, ",", -1)
For u = LBound(data) To UBound(data)
mxrow = Range(Split(data(u), "=")(0) & Rows.Count).End(xlUp).Row
adrs1 = Range(Split(data(u), "=")(0) & 1).Address(0, 0)
adrs2 = Range(Split(data(u), "=")(1) & 1).Address(0, 0)
Range("z1").Offset(, u).Resize(mxrow).Formula = "=if(and(counta(" & adrs1 & "," _
& adrs2 & "),exact(left(" & adrs1 & "," & idx & "),left(" & adrs2 & "," _
& idx & "))),""重複"",""相違"")"
Next u
End If
End Sub
'--------------------------------
Sub スーパー夢マクロ()
Dim dic As Object, i As Long, n As Integer, idx As Integer, tbl, rng As String, x, data
Set dic = CreateObject("scripting.dictionary")
rng = StrConv(InputBox("範囲は何処と何処でっか？ A〜D といった塩梅に書き込んでくらはい。"), vbNarrow)
If rng = "" Then MsgBox " 入力されとりまへん": Exit Sub
idx = StrConv(InputBox("何文字目（数字、英字、その他も含む）まで文字の重複検索？"), vbNarrow)
If idx = 0 Then MsgBox "キチンと入力してくらはい": Exit Sub
data = Split(rng, "~")
tbl = Range(data(0) & 1).Resize(Range(data(0) & Rows.Count).End(xlUp).Row, _
Range(data(1) & 1).Column - Range(data(0) & 1).Column + 1)
ReDim x(1 To UBound(tbl, 1), 1 To 1)
For i = 1 To UBound(tbl, 1)
For n = 1 To UBound(tbl, 2)
If dic.exists(Left(tbl(i, n), idx)) Then
x(i, 1) = "重複"
Exit For
Else
dic(Left(tbl(i, n), idx)) = Empty
End If
If n = UBound(tbl, 2) Then x(i, 1) = "相違"
Next n
dic.Removeall
Next i
Range("z1").Resize(UBound(tbl, 1)) = x
End Sub
不要行削除〜（汗 （弥太郎） 12:11
うぁ〜すばらしいの一言で感動で何て言ったらいいか・・・ （弥太郎）さん本当にありがとうございます。。 Sub 夢マクロ()の方を使用してます。 一つ気になって・・・両方が”空白”の場合は”相違”となってしまうのですね。。 空白にする事って・・・何て欲張りですよね。 もしも修正していただけるなら、上記のマクロは消さずに下記へお願い出来ないでしょうか？(CE)
この関数の意味はおわかりでっか？ =IF(AND(COUNTA(A1,B1),LEFT(A1,4)=LEFT(B1,4)),"重複","相違") A1若しくはB1 或いはその両方にデータがあって、且つA1の左４文字とB1の左４文字が 一致していれば「重複」、一致していなければ「相違」と表示するっちゅう意味ですわ なぁ。 それに もしA1及びB1にデータがなければ「""」と表示しなさいと付け加えたらええだ けですから簡単にお分かりかと存じます。 頭捻って考えまひょぅ。でないと、はよ老けまっせ。^^ （弥太郎）
相違の部分を消すと言うことでしょうか？ =IF(AND(COUNTA(A1,B1),LEFT(A1,4)=LEFT(B1,4)),"重複","") マクロの部分も消去？で違った場合は相違は表示しないで 空白と同類になってしまう？ってことですよね？？(CE)
それやったら相違が表示されまへんでせぅ？ A列とB列になんぼかデータを入れ、C列に式を書き込んで試してみたらどないでっっか？
先ほども申し上げたように >もしA1及びB1にデータがなければ「""」と表示しなさいと付け加えたらええだ けですから簡単にお分かりかと存じます。 ですワ。
ここまできたらそう簡単にギブアップでけまへん？やろ？＾＾ もちょっと頑張ってみてくらはい。 （弥太郎）
ギブアップ・・いろんな場所にいれましたがエラーが(CE)
ギブアップでっかぁ・・・（ふか〜い溜め息＾＾）
'-------------------
Sub 夢マクロ()
Dim mxrow As Long, rng As String, idx As Integer, adrs1 As String, adrs2 As String, x
rng = InputBox("範囲は何処と何処でっか？ A=B,E=F,H=I といった塩梅に書き込んでくらはい。")
If rng = "" Then Exit Sub
idx = StrConv(InputBox("何文字目（数字、英字、その他も含む）まで文字の重複検索？"), vbNarrow)
If idx = 0 Then MsgBox "キチンと入力してくらはい": Exit Sub
If Not rng Like "*,*" Then
Range("z1").Resize(Range(Split(rng, "=")(0) & Rows.Count).End(xlUp).Row). _
Formula = "=if(counta(" & Split(rng, "=")(0) & 1 & "," & Split(rng, "=")(1) _
& 1 & ")=0,"""",if(and(counta(" & Split(rng, "=")(0) & 1 & "," _
& Split(rng, "=")(1) & 1 & "),left(" & Split(rng, "=")(0) _
& 1 & "," & idx & ")=left(" & Split(rng, "=")(1) & 1 & "," _
& idx & ")),""重複"",""相違""))"
Exit Sub
Else
data = Split(rng, ",", -1)
For u = LBound(data) To UBound(data)
mxrow = Range(Split(data(u), "=")(0) & Rows.Count).End(xlUp).Row
adrs1 = Range(Split(data(u), "=")(0) & 1).Address(0, 0)
adrs2 = Range(Split(data(u), "=")(1) & 1).Address(0, 0)
Range("z1").Offset(, u).Resize(mxrow).Formula = "=if(counta(" & adrs1 & "," _
& adrs2 & ")=0,"""",if(and(counta(" & adrs1 & "," _
& adrs2 & "),left(" & adrs1 & "," & idx & ")=left(" & adrs2 & "," _
& idx & ")),""重複"",""相違""))"
Next u
End If
End Sub
（弥太郎）さん本当にありがとうございました。 感謝しています。今後もよろしくお願いいたします。(CE)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.